is there a way to improve my current macro to run faster?

[jo206]

hi all

I have this macro but it's taking too long, I usually have about 7000 rows. this macro deletes rows in sheet1 based on values in sheet2.

is there a way to improve my current macro to run faster?

thank you!

Sub XYZ()
Dim LR As Long, i As Long
With Sheets("Sheet1")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
        If IsNumeric(Application.Match(.Range("A" & i).Value, Sheets("Sheet2").Columns("A"), 0)) Then .Rows(i).Delete
    Next i
End With
End Sub

 

[Georgiboy]

The below should be faster:

Sub XYZ()
    Dim LR As Long, i As Long, uRng As Range
    With Sheets("Sheet1")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        For i = LR To 1 Step -1
            If IsNumeric(Application.Match(.Range("A" & i).Value, Sheets("Sheet2").Columns("A"), 0)) Then
                If uRng Is Nothing Then
                    Set uRng = .Range("A" & i)
                Else
                    Set uRng = Union(uRng, .Range("A" & i))
                End If
            End If
        Next i
        uRng.EntireRow.Delete
    End With
End Sub

 

[pcc]

The below should be faster:

Sub XYZ()
    Dim LR As Long, i As Long, uRng As Range
    With Sheets("Sheet1")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        For i = LR To 1 Step -1
            If IsNumeric(Application.Match(.Range("A" & i).Value, Sheets("Sheet2").Columns("A"), 0)) Then
                If uRng Is Nothing Then
                    Set uRng = .Range("A" & i)
                Else
                    Set uRng = Union(uRng, .Range("A" & i))
                End If
            End If
        Next i
        uRng.EntireRow.Delete
    End With
End Sub

And turn your screen updating off as well..

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

I think that you would find this much faster again. (Don't be put off by the length of the code )
Test with a copy of your workbook.

Sub XYZ_v2()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet2")
    a = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
  End With
  For i = 1 To UBound(a)
    d(a(i, 1)) = 1
  Next i
  With Sheets("Sheet1")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If d.exists(a(i, 1)) Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A1").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
  MsgBox "Done" 'You could remove this line
End Sub

Edit: Just did a timing test with 7,000 rows where about half (scattered throughout) get deleted.
Post #2: 19.9 seconds
This code: 0.04 seconds