Try the code below, change the sheetnames to suit.
Code:Sub CCCCB() Dim c As Range, DeleteRange As Range For Each c In Sheets("Sheet2").Range("A2:A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row) If WorksheetFunction.CountIf(Sheets("Sheet1").Range("A2:A" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row), c) = 0 Then If DeleteRange Is Nothing Then Set DeleteRange = Rows(c.Row) Else Set DeleteRange = Union(DeleteRange, Rows(c.Row)) End If End If Next DeleteRange.Delete End Sub




Reply With Quote
Bookmarks