1

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

BigBen
  • 46,229
  • 7
  • 24
  • 40
PhilNBlanks
  • 117
  • 1
  • 1
  • 8
  • 1
    As an aside, [here's a simpler way to store a range in an array](https://stackoverflow.com/a/37689901/2727437) – Marcucciboy2 Nov 11 '19 at 15:02
  • 1
    You should try stepping through your code with `F8` to see which line causes your program to freeze. At first glance I can't spot any major mistakes. Also: In most cases you can interrupt code execution by pressing `Esc`. – riskypenguin Nov 11 '19 at 15:12
  • 1
    Try moving the `wks.Range("AM" & i + 2) = Results_arr(i)` assignment outside the loop; you can write to `wks.Range("AM2:AM" & LastRow-1)` in a single worksheet-write operation after the whole array is populated. Avoiding worksheet manipulations inside loops will go a long way towards making your code more efficient. – Mathieu Guindon Nov 11 '19 at 15:18
  • Same with the `Ecode_arr(i) = wks.Range("A" & i + 1)` loop - consider `Ecode_arr = Application.Transpose(wks.Range("A1:A" & LastRow))` instead of looping to read each cell value individually. Note that the result will be a 1-based variant array; you'll want to change these hard-coded lower bounds to loop from `LBound(theArrayYouAreIterating) To UBound(theArrayYouAreIterating)`. – Mathieu Guindon Nov 11 '19 at 15:22
  • I've done some testing and could replicate the issue. I agree with @MathieuGuindon, when the write operation is performed outside of the loop, it is near instant as it should be. Simply take out `wks.Range("AM" & i + 2) = Results_arr(i)` and put in `wks.Range("AM2:AM" & i) = Results_arr` just above `End sub` – Plutian Nov 11 '19 at 15:31

1 Answers1

2

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 :)

Mathieu Guindon
  • 69,817
  • 8
  • 107
  • 235
  • Mathieu, I just posted an answer to my own question which is really follow up to your response. @MathieuGuindon – PhilNBlanks Nov 12 '19 at 14:28