CODEWITHSUNDEEP
vbaperformance
Davide Tarsitano
Davide Tarsitano

Reputation: 3

How do I speed up a double for loop with if in the inner loop in vba?

I've written this code to search a match in a column of sheet "q1" with the elements of another column in sheet "Complete Car". Since I have 3000 rows to check in Complete Car and 1500 in q1 (inner loop), is there any suggestion on how to write this more efficiently?

Code is below:

Sub PopulateData()

 Sheets("Q1").Visible = True

  Dim i As Integer
  Dim j As Integer

  For i = 4 To 3000

        For j = 2 To 1500


        If Worksheets("Complete Car").Cells(i, 2) = Worksheets("Q1").Cells(j, 21) Then

           Worksheets("Complete Car").Cells(i, 32) = Worksheets("Q1").Cells(j, 30)

           End If

        Next j

  Next i


  Sheets("Q1").Visible = False

Upvotes: 0

Views: 56

Answers (3)

buran
buran

Reputation: 14233

Sub PopulateData()

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Worksheets("Complete Car").Range("AF4:AF3000").FormulaR1C1 = "=VLOOKUP('Complete Car'!RC2,Q1!R2C21:R1500C30,10,FALSE)"

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

    ' Convert formulas to values
    With Worksheets("Complete Car").Range("AF4:AF3000")
        .Value = .Value
    End With

End Sub

Upvotes: 0

Damian
Damian

Reputation: 5174

Even though this is a question for code review, here is an answer using dictionaries and arrays:

Option Explicit
Sub PopulateData()

    Dim arrCompleteCar As Variant, arrQ1 As Variant
    Dim i As Integer, j As Integer
    Dim Matches As New Scripting.Dictionary 'You will need the library Microsoft Scripting Runtime

    Application.ScreenUpdating = False 'speed up the code since excel won't show you what is happening

    'First of all, working on arrays always speeds up a lot the code because you are working on memory
    'instead of working with the sheets
    With ThisWorkbook
        arrCompleteCar = .Sheets("Complete_Car").UsedRange.Value 'this will throw your entire sheet into one 2D array
        arrQ1 = .Sheets("Q1").UsedRange.Value
    End With

    'Then we create a dictionary with the data on worksheet Q1
    For i = 2 To UBound(arrQ1) 'from row 2 to the last on Q1 (the highest)
        If arrQ1(i, 21) = vbNullString Then Exit For 'this is to avoid looping through blank cells
        If Not Matches.Exists(arrQ1(i, 21)) Then 'this is to avoid duplicates
            Matches.Add arrQ1(i, 21), arrQ1(i, 30) 'we add the matching value with the one to replace
        End If
    Next i

    arrQ1 = Nothing 'empty the Q1 array since it's useless now

    'Now we loop the Complete Car worksheet
    For i = 4 To UBound(arrCompleteCar)
        'in case we find a match, we replace the column 32 with the column 30 from Q1
        If Matches.Exists(arrCompleteCar(i, 2)) Then arrCompleteCar(i, 32) = Matches(arrCompleteCar(i, 2))
    Next i

    ThisWorkbook.Sheets("Complete_Car").UsedRange.Value = arrCompleteCar 'we paste the array back to the sheet

    arrCompleteCar = Nothing
    Matches.RemoveAll

    Application.ScreenUpdating = True 'return excel to normal

End Sub

Upvotes: 1

Scott Craner
Scott Craner

Reputation: 152515

Use Variant arrays

Sheets("Q1").Visible = True

With Worksheets("Complete Car")
    Dim vlue() As Variant
    vlue = .Range(.Cells(4, 2), .Cells(3000, 2))

    Dim out() As Variant
    ReDim out(1 To UBound(vlue, 1), 1 To 1)
End With

With Worksheets("Q1")
    Dim lkup() As Variant
    lkup = .Range(.Cells(2, 21), .Cells(1500, 30))
End With

Dim i As Long
For i = LBound(vlue, 1) To UBound(vlue, 1)
    Dim j As Long
    For j = LBound(lkup, 1) To UBound(lkup, 1)
        If vlue(i, 1) = lkup(j, 1) Then
            out(i, 1) = lkup(j, 10)
            Exit For
        End If
    Next j
Next i

Worksheets("Complete Car").Cells(4, 32).Resize(UBound(out, 1), UBound(out, 2)).Value = out

Sheets("Q1").Visible = False

Upvotes: 3

Related Questions