Sub ColumnsCompare3()

Dim i As Long, n As Long
Dim LRow1 As Long, LRow2 As Long
Dim MyArr As Variant

LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr = Sheets("Sheet2").Range("H2:H" & LRow2)

Application.ScreenUpdating = False

Sheets("Sheet2").Range("A2:Z" & LRow2).Copy
Sheets("Sheet3").Range("A1").PasteSpecial xlPasteValues

With WorksheetFunction
For i = LBound(MyArr) To UBound(MyArr)
If .CountIf(Sheets("Sheet1").Range("C:C"), MyArr(i, 1)) = 0 Then
n = .Match(MyArr(i, 1), Sheets("Sheet3").Range("H1:H" & LRow2), 0)
Sheets("Sheet3").Rows(n).Delete
End If
Next
End With

Application.ScreenUpdating = True
End Sub


Regards
Claus B.


Thanks guys, got lots of codes to test.

Claus, this ColumnsCompare3() code seems to do well, except it writes to A1 on sheet 3 each time.

Was looking for the equivalent of:

Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2)

For each time the code is run. The next empty cell in column A for each run of the code.

Do you think the delete the non-match is ok on much larger columns , say 1500 to 3000 rows on sheet1 and sheet2?

Howard