Faster code for cuting 'good row range' from sh2 to sh1? - excel

Question

Does it exist any way to make this code run faster as it goes one row by one row ?
Sub cut_good_row_range_from_sh2_to_sh1()
Application.ScreenUpdating = False
For i = 2 To Sheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
For j = 2 To Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row
'Caution: I want to cut BB:BD, so I select BA:BD !
If Sheets("sheet1").Range("A" & i).Value = Sheets("sheet2").Range("A" & j).Value Then
Sheets("sheet2").Range("BA" & j & ":BS" & j).Cut Sheets("sheet1").Range("BA" & i & ":BS" & i)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Thanks ;)

Answer 1

It has been demonstrated on SO many times that looping over ranges is slow, and looping over variant arrays is much faster.
The 'best' method depends on the specifics of the use case. Making as few assumptions as I can, this demo shows how effective it can be. The assumptions made are
Data only is required, Format is not transfered.
No Formulas exist in the Destination range (If they do, they will be overwritten with their current value)
This is a simplistic example, further optimisations can be made.
Sub Demo()
Dim Found As Boolean
Dim i As Long, j As Long, k As Long
Dim rSrcA As Range, rSrc As Range
Dim vSrcA As Variant, vSrc As Variant
Dim rDstA As Range, rDst As Range
Dim vDstA As Variant, vDst As Variant
Dim rClear As Range
' Get references to Source Data Range and Variant Array
With Worksheets("Sheet2")
Set rSrcA = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
vSrcA = rSrcA.Value
Set rSrc = .Range("BA1:BS1").Resize(UBound(vSrcA, 1))
vSrc = rSrc
End With
' Get references to Destination Data Range and Variant Array
With Worksheets("Sheet1")
Set rDstA = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
vDstA = rDstA.Value
Set rDst = .Range("BA1:BS1").Resize(UBound(vDstA, 1))
vDst = rDst
End With
' Loop Source
For i = 1 To UBound(vSrcA, 1)
' Loop Destination
For j = 1 To UBound(vDstA, 1)
' Compare
If vSrcA(i, 1) = vDstA(j, 1) Then
Found = True
' Update Destination Data Array, to be copied back to sheet later
For k = 1 To UBound(vSrc, 2)
vDst(j, k) = vSrc(i, k)
Next
End If
Next
' If match found, track Source range to clear later
If Found Then
If rClear Is Nothing Then
Set rClear = rSrc.Rows(i)
Else
Set rClear = Union(rClear, rSrc.Rows(i))
End If
Found = False
End If
Next
' Update Destination Range
rDst.Value = vDst
' Clear Source Range
rClear.ClearContents
End Sub
When run on a test data set of 15 source rows and 200 destination rows, this reduced execution time from about 17s to about 10ms