Macro to match entries in column A on diff sheets

[blackie42]

Hi - Wonder if some one can help

I have Sheet 1 with around 100,000 entries and sheet 2 with around 89,000 entries.

Need to delete any out of Sheet 1 that aren't in sheet 2 (both items to match in col A)

Is there a qucik way to do this with VBA/lookup

many thanks
Jon

[Aussiebear]

Having a guess,

Sub CompareRanges()
[Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim lrow1 As Long
Dim lrow2 As Long
Dim rng1 As Range
Dim rng2 As Range
'Get the last row with data for both list sheets
lrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Ro
lrow2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
[Set rng1 = sh1.Range("A1:A" & lrow1)
Set rng2 = sh2.Range("A : A"& & lrow2)
For each Cll in rng1
If Cll.Value <> (rng Cll.Value) = 0 Then
Cll.Value.Delete
Next Cll
End if
Next
End Sub

[Bob Phillips]

Loopless


Public Sub DeleteRowsByFormula()
Dim rng As Range
Dim lastrow As Long

Application.ScreenUpdating = False

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns(2).Insert
.Range("B1").Value = "tmp"
.Range("B2").Resize(lastrow - 1).Formula = "=ISNUMBER(MATCH(A2,Sheet2!A:A,0))"
Set rng = .Range("B2").Resize(lastrow - 1)
Columns(2).AutoFilter Field:=1, Criteria1:="=FALSE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
.Columns(2).Delete
End With

Application.ScreenUpdating = True
End Sub

[blackie42]

Thanks Guys,

Aussie's code had some errors so I used Bobs and it did the trick.

much appreciated
Jon