How To Make a Loop Within A Loop In VBA More Efficient?-CodePudding

So I removed some of the defining variables and other details for simplicity sake. But I basically have a loop that loops through about 20 rows of populated data, then another loop inside of it that loops through about 2000 rows of data. The basic goal is to to match product codes from the 20 row sheet to product codes in the 2000 row sheet. I'm fairly new with VBA and don't know a lot of the VBA functions I could possibly use to achieve the same result as using loops, so any assistance is appreciated!

Note: It works perfectly as is, but it just takes a really long time (like 5 minutes) to execute. I've already added in Application.ScreenUpdating = False and Application.Calculation = xlManual

For iiii = 2 To RLast

For v = 2 To Last2

    If ws2.Cells(v, 7) = ws3.Cells(iiii, 1) Then
        If ws2.Cells(v, 1) <> "FLHIGH" And ws2.Cells(v, 1) <> "VLOWER" Then
            AmountCount2 = AmountCount2   ws2.Cells(v, 8)
            AmountCount = ws2.Cells(v, 9)
            Coun = 1
            Crit1 = ws2.Cells(v, 5)
        Else
            If Cranes(Locat, Forbidden, Forbidden2, Forbidden3, Forbidden4, Forbidden5) = False Then
                If Coun = 0 Then
                    AmountCount = AmountCount   (ws2.Cells(v, 8)   ws2.Cells(v, 9))
                    Crit2 = ws2.Cells(v, 5)
                    Coun = 1
                Else
                    AmountCount = AmountCount   (ws2.Cells(v, 8))
                    Crit2 = ws2.Cells(v, 5)
                End If
            Else 
                AmountCount = ws2.Cells(v, 9)
                Crit2 = ws2.Cells(v, 5)
            End If
        End If
    End If
    ws3.Cells(iiii, 4) = AmountCount 
    ws3.Cells(iiii, 5) = AmountCount2 
Next v

Next iiii

CodePudding user response：

Writing Ranges to Arrays

Dim srCount As Long: srCount = Last2 - 1
Dim srg As Range: Set srg = ws2.Rows(2).Columns("A:I").Resize(srCount)
Dim sData As Variant: sData = srg.Value

Dim drCount As Long: drCount = RLast - 1
Dim drg As Range: Set drg = ws3.Rows(2).Columns("A:E").Resize(drCount)
Dim dlData As Variant: dlData = drg.Columns("A").Value
Dim dvrg As Range: dvrg = drg.Columns("D:E")
Dim dvData As Variant: dvData = dvrg.Value

Dim sr As Long
Dim dr As Long

For dr = 1 To drCount
    For sr = 1 To srCount
        If sData(sr, 7) = dlData(dr, 1) Then
            If sData(sr, 1) <> "FLHIGH" And sData(sr, 1) <> "VLOWER" Then
                AmountCount2 = AmountCount2   sData(sr, 8)
                AmountCount = sData(sr, 9)
                Coun = 1
                Crit1 = sData(sr, 5)
            Else
                If Cranes(Locat, Forbidden, Forbidden2, Forbidden3, _
                        Forbidden4, Forbidden5) = False Then
                    If Coun = 0 Then
                        AmountCount = AmountCount   sData(sr, 8) _
                              sData(sr, 9)
                        Crit2 = sData(sr, 5)
                        Coun = 1
                    Else
                        AmountCount = AmountCount   sData(sr, 8)
                        Crit2 = sData(sr, 5)
                    End If
                Else
                    AmountCount = sData(sr, 9)
                    Crit2 = sData(sr, 5)
                End If
            End If
        End If
    Next sr

    dvData(dr, 1) = AmountCount
    dvData(dr, 2) = AmountCount2

Next dr

dvrg.Value = dvData

CodePudding user response：

You might want to use
Application.Calculation = xlManual and
Application.Calculation = xlAutomatic
if possible in your case.

With your code and an empty if loop searching 20 data
fields in 2000 rows I got the following results:

... your code: minutes
... switching off calculation: seconds
... with arrays (VBasic2008's approach): milliseconds

Depending on your data (Does your search data match only once in the product row data?) it might make sense to avoid 40.000 loops and use the inbuilt MATCH function? And use an UDF (user defined function) for the " ... AmountCount ... " stuff?