CODEWITHSUNDEEP
excelvba
PhilNBlanks
PhilNBlanks

Reputation: 125

Why does this code causes an infinite loop

In the code attached (two macros) if I call "SortBy Ecode" from within "EcodeKeep" the code never ends. (or at least doesn't end within 5 min when I force Quit excel).

However, If I run "SortByEcode" seperately before running "EcodeKeep" they each run in under 2 seconds.

There are a little over 19K rows of data in the spreadsheet. Also, this is my first attempt at working with arrays in VBA.

What am I doing wrong?

Sub EcodeKeep()
     Dim i As Long
     Dim LastRow As Long

     Call SortByEcode  'Calling this sort macro here causes this code to run forever.

     Dim wks As Worksheet
     Set wks = rawData5            'Work in sheet("RawEquipHistory")
     LastRow = wks.Range("A" & Rows.Count).End(xlUp).Row
     StartTime = Timer

     Dim Ecode_arr() As Variant
          ReDim Ecode_arr(LastRow)
     Dim Results_arr() As String
          ReDim Results_arr(LastRow)

     For i = 0 To LastRow - 1  'Read data into Ecode_arr(i)
          Ecode_arr(i) = wks.Range("A" & i + 1)
     Next i

     wks.Range("AM1") = "ECODE KEEP"  'Add the header to "S1"
     For i = 0 To LastRow - 1
          If Ecode_arr(i + 1) <> Ecode_arr(i) Then
               Results_arr(i) = True
          Else
               Results_arr(i) = False
          End If
          wks.Range("AM" & i + 2) = Results_arr(i)
     Next i
End Sub

Sub SortByEcode()
 '  SORT sheet by E-Code (Column A)
      Dim LastRow As Long
     LastRow = ThisWorkbook.Sheets("RawEquipHistory").Range("A" & Rows.Count).End(xlUp).Row

     With ThisWorkbook.Sheets("RawEquipHistory").Sort               '  SORT sheet by E-Code(a)
          .SortFields.Clear
          .SortFields.Add Key:=Range("A1:A" & LastRow), Order:=xlAscending
          .SetRange Range("A1:AZ" & LastRow)
          .Header = xlYes
          .Apply
     End With
End Sub

Upvotes: 1

Views: 227

Answers (1)

Mathieu Guindon
Mathieu Guindon

Reputation: 71227

Your loop isn't infinite, only inefficient.

Unless you've disabled automatic calculations, application/worksheet events, and screen updating, then every time a cell is written to, Excel tries to keep up with the changes, and eventually fails to do so, goes "(not responding)", and at that point there's not much left to do but wait it out... and it can take a while.

You can work on the symptoms and disable automatic calculations, application/worksheet events, and screen updating - your code will run to completion, faster.

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False

Of course you would then reset these to their original values after the loops are completed, and you want to be careful to also reset them if anything goes wrong in the procedure, i.e. whenever you toggle those, you want an error-handling subroutine.

Or you can work on the root cause, and tweak the approach slightly, by reducing the worksheet operations to a bare minimum: one single read, one single write. ...and then whether automatic calculations are enabled, whether Excel fires worksheet events and repaints the screen every time you write to a cell will make no difference at all.

The secret sauce, is variant arrays. You had the right idea here:

 Dim Ecode_arr() As Variant
      ReDim Ecode_arr(LastRow)
 Dim Results_arr() As String
      ReDim Results_arr(LastRow)

But then reading the values one by one takes a toll:

 For i = 0 To LastRow - 1  'Read data into Ecode_arr(i)
      Ecode_arr(i) = wks.Range("A" & i + 1)
 Next i

Don't bother sizing the arrays, keep them as plain old Variant wrappers - with Application.Transpose, you can get a one-dimensional Variant array from your one-column source range:

Dim ecodes As Variant
ecodes = Application.Transpose(wks.Range("A1:A" & LastRow).Value)

Now you can iterate this array to populate your output array - but don't write to the worksheet just yet: writing the values one by one to the worksheet is eliminating the need for a result/output array in the first place!

Note that because we are assigning a Boolean value with True in one branch and False in the other branch of a conditional, we can simplify the assignment by assigning directly to the Boolean expression of the conditional:

 ReDim results(LBound(ecodes), UBound(ecodes))

 Dim i As Long
 For i = LBound(results) To UBound(results) - 1
     results(i) = ecodes(i + 1) <> ecodes(i)
 Next

And now that the results array is populated, we can dump it onto the worksheet, all at once - and since this is the only worksheet write we're doing, it doesn't matter that Excel wants to recalculate, raise events, and repaint: we're done!

wks.Range("AM2:AM" & i + 1).Value = results

Note: none of this is tested code, an off-by-one error might have slipped in as I adjusted the offsets (arrays received from Range.Value will always be 1-based). But you get the idea :)

Upvotes: 2

Related Questions