Can I make it faster? I iterates through 20k rows /- for 4-5 minutes-CodePudding

I am trying to make a macro that assigns the name of maneuver (Ramping Up, Flat Cruise, Ramping Down) for specific behaviour of set of data. I decided to divide the large data set into subsets that consist 5 cells and the code is checking its behaviour (either is the value getting smaller or bigger).

.csv file consists more or less 20k rows and the code iterates through it for 5 minutes. Can I make it somewhat faster?

The outer for loop is dividing the set of data into subsets that consists 5 cells. Slow iterators manipulate those values.

Then it just assigns values depending the values in cells are decreasing or increasing

Sub maneuverSet(lu As Worksheet, nr As Long)
    lu.Activate

    Dim fast_ite As Long, slow_ite As Integer, numRows As Long
    
    Dim slow_1 As Long, slow_2 As Long, slow_3 As Long, slow_4 As Long, slow_5

    numRows = nr 'definition in main: numRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
    Application.ScreenUpdating = False

    For fast_ite = 4 To numRows Step 5
        Dim ite_array As Variant
    
        slow_1 = fast_ite - 2
        slow_2 = fast_ite - 1
        slow_3 = fast_ite
        slow_4 = fast_ite   1
        slow_5 = fast_ite   2
    
        ite_array = Array(slow_1, slow_2, slow_3, slow_4, slow_5)
    
        ' Now it just checks if the cell consist the values that ramping up with each row or not.
    
        If Cells(slow_1, "A") < Cells(slow_2, "A") And Cells(slow_1, "A") < Cells(slow_2, "A") And Cells(slow_2, "A") < Cells(slow_3, "A") _
            And Cells(slow_3, "A") < Cells(slow_4, "A") And Cells(slow_4, "A") < Cells(slow_5, "A") Then
    
            For Each iterator In ite_array
                Cells(iterator, "AB") = "RampUp"
            Next
    
        ElseIf Cells(slow_1, "A") > Cells(slow_2, "A") And Cells(slow_1, "A") > Cells(slow_2, "A") And Cells(slow_2, "A") > Cells(slow_3, "A") _
            And Cells(slow_3, "A") > Cells(slow_4, "A") And Cells(slow_4, "A") > Cells(slow_5, "A") Then
    
            For Each iterator In ite_array
                Cells(iterator, "AB") = "RampDown"
            Next
    
        Else
    
            For Each iterator In ite_array
                Cells(iterator, "AB") = "Cruise"
            Next

        End If
    Next
    Application.ScreenUpdating = True

End Sub

CodePudding user response：

Read/write to/from cell is usually a very slow action so you will want to avoid that as much as possible.

Instead, store the values into an array then process the logic through the array.

Without changing too much of your logic, this is probably what an array approach looks like:

Sub maneuverSet(lu As Worksheet, nr As Long)
    
    lu.Activate
    
    Dim fast_ite As Long, numRows As Long
     
    numRows = nr 'definition in main: numRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
    Application.ScreenUpdating = False
    
    For fast_ite = 4 To numRows Step 5
        'Assign the 5 values into an array for processing
        Dim dataArr As Variant
        dataArr = lu.Cells(fast_ite, "A").Offset(-2).Resize(5).Value
        
        Dim outcome As String 'used to store the outcome of this loop
        
        If dataArr(1, 1) < dataArr(2, 1) And _
            dataArr(2, 1) < dataArr(3, 1) And _
            dataArr(3, 1) < dataArr(4, 1) And _
            dataArr(4, 1) < dataArr(5, 1) Then
            
            outcome = "RampUp"
        ElseIf dataArr(1, 1) > dataArr(2, 1) And _
            dataArr(2, 1) > dataArr(3, 1) And _
            dataArr(3, 1) > dataArr(4, 1) And _
            dataArr(4, 1) > dataArr(5, 1) Then
            
            outcome = "RampDown"
        Else
            outcome = "Cruise"
        End If
        
        'Write the outcome into the 5 cells at once.
        lu.Cells(fast_ite, "AB").Offset(-2).Resize(5).Value = outcome
    Next
    Application.ScreenUpdating = True
End Sub

Below should be even faster as it only read and write cells twice:

Sub maneuverSet(lu As Worksheet, nr As Long)
    lu.Activate
           
    Application.ScreenUpdating = False
    
    'Read the entire data into an array
    Dim dataArr As Variant
    dataArr = lu.Range("A2:A" & nr).Value
    
    'Create another array of the same size to store the outcome (to be written into column AB)
    Dim outputArr() As String
    ReDim outputArr(1 To UBound(dataArr, 1), 1 To 1) As String
    
    'Loop through the array as per your logic
    Dim i As Long
    For i = 1 To UBound(dataArr, 1) Step 5
        Dim outcome As String
        
        If dataArr(i, 1) < dataArr(i   1, 1) And _
            dataArr(i   1, 1) < dataArr(i   2, 1) And _
            dataArr(i   2, 1) < dataArr(i   3, 1) And _
            dataArr(i   3, 1) < dataArr(i   4, 1) Then
            
            outcome = "RampUp"
        ElseIf dataArr(i, 1) > dataArr(i   1, 1) And _
            dataArr(i   1, 1) > dataArr(i   2, 1) And _
            dataArr(i   2, 1) > dataArr(i   3, 1) And _
            dataArr(i   3, 1) > dataArr(i   4, 1) Then
            
            outcome = "RampDown"
        Else
            outcome = "Cruise"
        End If
        
        Dim n As Long
        For n = i To i   4
            outputArr(n, 1) = outcome
        Next n
    Next i
    
    'Write the entire outcome array into the worksheet
    lu.Range("AB2:AB" & nr).Value = outputArr
    
    Application.ScreenUpdating = True
End Sub