May be this
Sub DelMatchedRows1()
Dim a(), b()
Dim c As Long, r As Long
Dim k As String
Dim rng As Range, x As Range
' Freeze screen updating
Application.ScreenUpdating = False
' Trap errors
On Error GoTo exit_
1 ' Copy data of Sheet2 to array b() for speeding up the code
With Sheets(2).UsedRange
b() = .Value
Set rng = .EntireRow
End With
2 ' Main
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
' Copy column A of Sheet1 to array a() to speed code up
a() = Sheets(1).UsedRange.Columns("A").Value
' Build dictionary of Sheet1 Column A
For r = 1 To UBound(a)
k = Trim(a(r, 1))
If Len(k) Then .Item(k) = 0
Next
3 ' Collect in x the rows to be deleted
For r = 1 To UBound(b)
For c = 1 To UBound(b, 2)
k = Trim(b(r, c))
If Len(k) Then
If .Exists(k) Then
' Collect the row for deleting
If x Is Nothing Then
Set x = rng.Rows(r)
Else
Set x = Union(x, rng.Rows(r))
End If
Exit For
End If
End If
Next
Next
End With
4 ' Delete the collected rows
If Not x Is Nothing Then x.Delete
exit_:
' Inform about the trapped error
If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number & ", ErrLine #" & Erl
' Restore screen updating
Application.ScreenUpdating = True
End Sub