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

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

1. Data only is required, Format is not transfered.
2. 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