Excel Macro help

[OverhandLeft]

Hello,

I want to delete rows that do not equal certain numbers

I want to put the numbers below in sheet1 and then have a macro that will do a vlookup on sheet2 and delete rows that do not equal the numbers in this list.

4000500A8
1A5001235
500A23146

If someone could help me out, it would really be apprecaited. Thanks in Advance!

[mikerickson]

Given a list in Sheet1!A:A (no blank rows between entries) and a list in Sheet2!A:A, this will delete those cells in Sheet1!A:A that do not appear in Sheet2!A:A. Sheet names and columns can be adjusted where indicated.
Sub test()
Dim dataRange As Range
Dim critRange As Range
Dim excludeRange As Range
Dim tempHeader As Variant
tempHeader = Array("tempHeader", "th2")
With ThisWorkbook
Set excludeRange = .Sheets("sheet2").Range("A:A"): Rem adjust
With .Sheets("sheet1").Range("A:A"): Rem adjust
With .Cells(1, 1).Resize(1, .Columns.Count)
.Insert shift:=xlDown
.Offset(-1, 0).Value = tempHeader
End With
Set dataRange = Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count - 1, 1).End(xlUp))
With .Parent.UsedRange
Set critRange = .Cells(1, .Column + .Columns.Count + 1).Resize(2, 1)
End With
End With
End With
critRange.Cells(2, 1).FormulaR1C1 = "=ISNA(MATCH(RC1," & excludeRange.Address(, , xlR1C1, True) & ",0))"
With dataRange
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=critRange, Unique:=False
critRange.EntireColumn.Delete
On Error Resume Next
.SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
.Parent.ShowAllData
On Error GoTo 0
Application.Goto reference:="R1C1"
End With
End Sub

[OverhandLeft]

worked perfectly...thanks!

[OverhandLeft]

I was wondering if you can help me out with one revision. Suppose I wanted to specify a range. I want to start at A7 and my range would be from A7 to the first empty row in column A.

Then I want to delete all the rows in that range that is not on the list.

what changes would I need to make in the code? Thanks again

[mikerickson]

The logic needed a little tweaking for an adjustable start row. This has startRow = 7.
Sub test2()
Dim dataRange As Range
Dim critRange As Range
Dim excludeRange As Range
Dim tempHeader As Variant
Dim startRow As Long
tempHeader = Array("tempHeader", "th2")
With ThisWorkbook
startRow = 7: Rem adjust
Set excludeRange = .Sheets("sheet2").Range("A:A"): Rem adjust
With .Sheets("sheet1").Range("A:A"): Rem adjust
With Range(.Cells(startRow, .Columns.Count), .Cells(.Rows.Count - 1, 1).End(xlUp))
With .Cells(1, 1).Resize(1, .Columns.Count)
.Insert shift:=xlDown
.Offset(-1, 0).Value = tempHeader
End With
End With
Set dataRange = Range(.Cells(startRow, .Columns.Count), .Cells(.Rows.Count - 1, 1).End(xlUp))
With dataRange
Set critRange = .Cells(1, .Parent.UsedRange.Column + .Parent.UsedRange.Columns.Count + 1).Resize(2, 1)
End With
End With
End With

critRange.Cells(2, 1).FormulaR1C1 = "=ISNA(MATCH(RC1," & excludeRange.Address(, , xlR1C1, True) & ",0))"
With dataRange
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=critRange, Unique:=False
critRange.EntireColumn.Delete
On Error Resume Next
.SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
.Parent.ShowAllData
On Error GoTo 0
Application.Goto reference:="R1C1"
End With
End Sub