Speed up VBA Code - Use an array instead maybe?

[CC268]

I posted a code on here previously that is somewhat similar to the code below...a fellow on here turned it into an array and literally transformed the code in terms of speed...it went from 12 minutes to 20 seconds. This code here takes about 4 minutes to run as it goes through about 5600 lines of data. Is there a way to speed this up (maybe by using an array instead)?

By the way - OptimizeCode_Begin and End call outs are the typical Application.ScreenUpdating, Application.EnableEvents, etc.

Thanks!

Sub Merge_Data()
'Call OptimizeCode_Begin

Dim cell1 As Range, rng1 As Range, cell2 As Range, rng2 As Range

Sheets("Sheet2").Range("A1:BB1").Copy Destination:=Sheets("Sheet1").Range("L1") 'copy column headers from Sheet 2 to Sheet 1
Set rng1 = Sheets("Sheet1").Range("E2:E" & Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "E").End(xlUp).Row) 'defining variable rng1 -->Sheet1, column E starting at E2 and going to last value in column E
Set rng2 = Sheets("Sheet2").Range("E2:E" & Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "E").End(xlUp).Row) 'defining variable rng2 -->Sheet2, column E starting at E2 and going to last value in column E

For Each cell2 In rng2 'for each cell in range 2 defined above (column E in Sheet 2)...
    For Each cell1 In rng1 'for each cell in range 1 defined above (column E in Sheet 1)...
        If cell2.Value = cell1.Value And cell2.Offset(0, -3) = cell1.Offset(0, -3).Value Then 'if the value of cell2 equals the value of cell1 AND the value of cell2 (offset by 3 columns) equals the value of cell1 (offset by 3 columns) then...
            Sheets("Sheet2").Range("A" & cell2.Row & ":BB" & cell2.Row).Copy Destination:=Sheets("Sheet1").Range("L" & cell1.Row & ":BM" & cell1.Row) 'copy corresponding columns A:BB from current row in Sheet 2 and copy into Sheet 1 corresponding columns L:BM into current row
        Exit For
        End If
    Next
Next
     
'Call OptimizeCode_End
End Sub

 

[StephenCrump]

Is there a way to speed this up (maybe by using an array instead)?

Yes, using VBA arrays would speed things up.

Another way would be to use Excel's MATCH function, rather than looping, along these lines:

Sub Merge_Data()

    Dim r1 As Long, r2 As Long
    
    r1 = 2
    r2 = Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Row
        
    With Sheets("Sheet1").Range("L" & r1 & ":BM" & Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row)
        .Formula = "=INDEX(Sheet2!A$" & r1 & ":A$" & r2 & ",MATCH(1,INDEX((Sheet2!$E$" & r1 & ":$E$" & r2 _
            & "=$E" & r1 & ")*(Sheet2!$B$" & r1 & ":$B$" & r2 & "=$B" & r1 & "),,1),))"
        .Value = .Value
    End With
End Sub

 

[CC268]

Yes, using VBA arrays would speed things up.

Another way would be to use Excel's MATCH function, rather than looping, along these lines:

Sub Merge_Data()

    Dim r1 As Long, r2 As Long
    
    r1 = 2
    r2 = Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Row
        
    With Sheets("Sheet1").Range("L" & r1 & ":BM" & Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row)
        .Formula = "=INDEX(Sheet2!A$" & r1 & ":A$" & r2 & ",MATCH(1,INDEX((Sheet2!$E$" & r1 & ":$E$" & r2 _
            & "=$E" & r1 & ")*(Sheet2!$B$" & r1 & ":$B$" & r2 & "=$B" & r1 & "),,1),))"
        .Value = .Value
    End With
End Sub

Thanks for the response I appreciate it - this did work, but unfortunately it wasn't really any quicker.

 

[Joe4]

Suppressing screen updates can help with speed (and prevent screen flickering).
Place:

Application.ScreenUpdating = False

at the beginning of your code and then place

Application.ScreenUpdating = True

at the end of it.

 

[CC268]

Yea I already have that done - as I stated in my original post OptimizeCode_Begin and End call outs are the typical Application.ScreenUpdating, Application.EnableEvents, etc.

It isn't a huge deal if I can't find a faster solution - the code works great, but I figured it wouldn't hurt to try to get this to run quicker.

 

[Joe4]

Yea I already have that done - as I stated in my original post OptimizeCode_Begin and End call outs are the typical Application.ScreenUpdating, Application.EnableEvents, etc.

But in the code you posted, it looks like you have commented those lines out, so they wouldn't be running.

 

[RoryA]

Cross-posted here: VBA Code Slow - Use an array instead?
Please read the forum rules, especially relating to cross-posting, and follow them in future. Thanks.

 

[CC268]

But in the code you posted, it looks like you have commented those lines out, so they wouldn't be running.

When I run this specific code by itself I uncomment them - reason they are commented now is I have another macro that calls all these individual modules - at the beginning of that I have OptimizeCode_Begin and End so that it runs throughout the entire process.

 

[StephenCrump]

Thanks for the response I appreciate it - this did work, but unfortunately it wasn't really any quicker.

It surprises me that you didn't get any material speed improvement.

The solution given to your cross-post still copies and pastes line by line. I'd expect working wholly in VBA and writing once to Excel to be faster, perhaps along these lines:

Sub Merge_Data()

    Dim v1 As Variant, v2 As Variant, vOut As Variant
    Dim lFirstRow As Long, lLastRow1 As Long, lLastRow2 As Long
    Dim lCols As Long, i As Long, j As Long, k As Long
    
    lFirstRow = 2
    lLastRow1 = Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row
    lLastRow2 = Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Row
    v1 = Sheets("Sheet1").Range("A" & lFirstRow & ":E" & lLastRow1).Value
    v2 = Sheets("Sheet2").Range("A" & lFirstRow & ":BB" & lLastRow2).Value
    lCols = UBound(v2, 2)
    ReDim vOut(1 To UBound(v1), 1 To lCols)
    
    For i = 1 To lLastRow1 - lFirstRow + 1
        For j = 1 To lLastRow2 - lFirstRow + 1
            If v1(i, 2) = v2(j, 2) And v1(i, 4) = v2(j, 4) Then
                For k = 1 To lCols
                    vOut(i, k) = v2(j, k)
                Next k
                Exit For
            End If
        Next j
    Next i
    
    Sheets("Sheet1").Range("L" & lFirstRow).Resize(UBound(v1), lCols).Value = vOut
    
End Sub