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
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 🙂