Delete Non Matching Rows using VBA

Question

I have two sheets in a workbook. Sheet 1 contains a fill list of values where sheet 2 contains a reduced list. I would like to delete the entire row in Sheet1 where there is no matching record in Sheet 2 using VBA. If there is a matching record in sheet 2 the next line on sheet 1 is checked and so on until the last record in sheet 1 is reached. Not sure how to code the match function in vba to perform the task and combining this with an if statement to delete the row(s).

Answer 1

Hi,

make a copy before you run the code..

i assume that data on both sheets are in column A.

(in row 1 are headings)

try this...

Sub DeleteNotMatch()

Const sh1Col As String = "A" ' << sheet1 data in col A, change

Const sh2Col As String = "A" ' << sheet2 data in col A, change

Dim ws1 As Worksheet, ws2 As Worksheet

Dim r1 As Long, r2 As Long

Set ws1 = Sheets("Sheet1")

Set ws2 = Sheets("Sheet2")

r1 = ws1.Cells(Rows.Count, sh1Col).End(xlUp).Row

r2 = ws2.Cells(Rows.Count, sh2Col).End(xlUp).Row

For i = r1 To 2 Step -1

For Each r In ws2.Range(sh2Col & "2:" & sh2Col & r2)

If ws1.Cells(i, sh1Col).Value = r.Value Then GoTo myNext

Next r

ws1.Cells(i, sh1Col).EntireRow.Delete

myNext:

Next i

End Sub

Answer 2

Ok,

try this..

Sub DeleteNotMatch22()

Const sh1Col As String = "A"

Const sh2Col As String = "A"

Dim ws1 As Worksheet, ws2 As Worksheet

Dim r1 As Long, r2 As Long, i As Long, x As Long

Set ws1 = Sheets("Sheet1")

Set ws2 = Sheets("Sheet2")

r1 = ws1.Cells(Rows.Count, sh1Col).End(xlUp).Row

r2 = ws2.Cells(Rows.Count, sh2Col).End(xlUp).Row

On Error Resume Next

For i = 2 To r2

x = Application.Match(ws2.Cells(i, sh2Col), ws1.Range(sh1Col & "1:" & sh1Col & r1), 0)

ws1.Cells(x, 255) = "xx"

Next i

ws1.Cells(1, 255) = "xx"

Intersect(ws1.UsedRange, ws1.Columns(255)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

ws1.Columns(255).ClearContents

End Sub

Answer 3

Thanks TasosK

I have circa 38,000 rows to checl. is there a faster approach?