Deleting Rows based on matching values in column A, in two different worksheets

I am comparing column A of two different worksheets. I want keep all of the column A values that are in both sheets. I want to delete the rows of those values in sheet2 that do no appear in sheet1. Can someone please help?

Thank you!

This should do it

Option Explicit
Sub abc()
 Const sh1 As String = "sheet1"
 Const sh2 As String = "sheet2"
 Dim aArr As Variant, i As Long, ii As Long, n As Long
 Dim a
 With Worksheets(sh1)
    aArr = .Range("a2", .Cells(Rows.Count, "a").End(xlUp))
 End With
 
 With CreateObject("scripting.dictionary")
    .comparemode = 1
    For i = 1 To UBound(aArr)
        If Not .exists(aArr(i, 1)) Then
            .Item(aArr(i, 1)) = aArr(i, 1)
        End If
    Next
    With Worksheets(sh2)
       aArr = .Range("a1").CurrentRegion
    End With
    
    ReDim a(1 To UBound(aArr), 1 To UBound(aArr, 2))
    For i = 1 To UBound(aArr)
        If .exists(aArr(i, 1)) Then
            n = n + 1
            For ii = 1 To UBound(aArr, 2)
                a(n, ii) = aArr(i, ii)
            Next
        End If
    Next
 End With
 With Worksheets(sh2)
    .Range("a2", .Cells(Rows.Count, .UsedRange.Columns.Count).End(xlUp).Offset(1)).ClearContents
    .Cells(2, 1).Resize(n, UBound(a, 2)) = a
 End With
End Sub

This maybe faster

Option Explicit
Sub abc()
 Const sh1 As String = "sheet1"
 Const sh2 As String = "sheet2"
 Dim aArr As Variant, i As Long, ii As Long, n As Long

 With Worksheets(sh1)
    aArr = .Range("a2", .Cells(Rows.Count, "a").End(xlUp))
 End With
 
 With Application
    .ScreenUpdating = False
    With CreateObject("scripting.dictionary")
       .comparemode = 1
       For i = 1 To UBound(aArr)
           If Not .exists(aArr(i, 1)) Then
               .Item(aArr(i, 1)) = aArr(i, 1)
           End If
       Next
       With Worksheets(sh2)
          aArr = .Range("a1").CurrentRegion
       End With
       
       For i = UBound(aArr) To 2 Step -1
           If Not .exists(aArr(i, 1)) Then
               Worksheets(sh2).Rows(i).Delete
           End If
       Next
       
    End With
    .ScreenUpdating = True
 End With
End Sub

Hi,

Try this - what do you want to do about duplicates in Sheet2??

Sub Anonymous(): Dim r As Long, F As Range, A As Range, T As Range
r = ActiveWorkbook.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).row
Set A = ActiveWorkbook.Sheets("Sheet2").Range("A2:A" & r)
For Each T In A
Set F = ActiveWorkbook.Sheets("Sheet1").Range("A2:A" & r).Find(What:=T)
If Not F Is Nothing Then GoTo GetNext
T.EntireRow.Delete Shift:=xlUp
GetNext: Next
End Sub

Directions for running the routine(s) just supplied

Copy the code to the clipboard

Press ALT + F11 to open the Visual Basic Editor.

Open a macro-enabled Workbook or save your Workbook As Macro-Enabled

Select “Module” from the Insert menu

Type "Option Explicit" then paste the code into the white space on the right

With the cursor between Sub and End Sub press F5 (F8 to Single Step)

OR

Press ALT + Q to close the code window.

Press ALT + F8 then double click on the macro name

This should do it

Option Explicit
Sub abc()
 Const sh1 As String = "sheet1"
 Dim ws As Worksheet
 Dim aArr As Variant, i As Long, ii As Long, n As Long

 With Worksheets(sh1)
    aArr = .Range("a2", .Cells(Rows.Count, "a").End(xlUp))
 End With
 
 With Application
    .ScreenUpdating = False
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(aArr)
            If Not .exists(aArr(i, 1)) Then
               .Item(aArr(i, 1)) = aArr(i, 1)
            End If
        Next
        For Each ws In Worksheets
            If ws.Name <> sh1 Then
               aArr = ws.Range("a1").CurrentRegion
               For i = UBound(aArr) To 2 Step -1
                   If Not .exists(aArr(i, 1)) Then
                       ws.Rows(i).Delete
                   End If
               Next
            End If
        Next
    End With
    .ScreenUpdating = True
 End With
End Sub

If I wanted to do this for two excell documents, the first of which has 20 tabs, the second has 23. How would I do this?
If sheet1 has the list to compare from, and every sheet after that has the column A to delete rows from.

You need to have the Excel Documents Active then just play this:

Sub Anonymous(): Dim r As Long, F As Range, A As Range, T As Range, ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
r = ws.Range("A" & Rows.Count).End(xlUp).row
Set A = ws.Range("A2:A" & r)
For Each T In A
Set F = ActiveWorkbook.Sheets("Sheet1").Range("A2:A" & r).Find(What:=T)
If Not F Is Nothing Then GoTo GetNext
T.EntireRow.Delete Shift:=xlUp
GetNext: Next: Next
End Sub

Pace this in a separate workbook. The workbooks that your wanting to remove rows from must be opened before running macro.

Also change this part of the code to the names of your workooks

 aArrWorkbooks = Array("Book1.xlsx", "Book2.xlsx") '<--- Change to the names of the workbooks
                                                   '<--- you want to delete the rows.
                                                   '<--- Both of these workbooks must be opened
                                                   '<--- when running the macro.

Option Explicit
Sub test()
 Dim aArrWorkbooks
 
 aArrWorkbooks = Array("Book1.xlsx", "Book2.xlsx")
 
 Dim wb As Workbook
 For Each wb In Workbooks
    If wb.Name = aArrWorkbooks(0) Or wb.Name = aArrWorkbooks(1) Then
        Debug.Print wb.Name
    End If
 Next
End Sub
Sub abc()
 Const sh1 As String = "sheet1"
 Dim wb As Workbook
 Dim ws As Worksheet
 Dim aArr As Variant, i As Long, ii As Long, iBook As Long
 Dim aArrWorkbooks
 
 
 aArrWorkbooks = Array("Book1.xlsx", "Book2.xlsx") '<--- Change to the names of the workbooks
                                                   '<--- you want to delete the rows.
                                                   '<--- Both of these workbooks must be opened
                                                   '<--- when running the macro.
 
 With Application
    .ScreenUpdating = False
    For iBook = 0 To UBound(aArrWorkbooks)
        On Error Resume Next
        Set wb = Workbooks(aArrWorkbooks(iBook))
        Set ws = wb.Worksheets(sh1)
        If Err.Number <> 0 Then
            MsgBox "Workbook " & aArrWorkbooks(iBook) & " is not opened. Or" & vbCrLf & _
                   "Worksheet " & sh1 & " does not exists."
            GoTo EarlyExit
        End If
        On Error GoTo 0
        With ws
           aArr = .Range("a2", .Cells(Rows.Count, "a").End(xlUp))
        End With
        
        With CreateObject("scripting.dictionary")
            .comparemode = 1
            For i = 1 To UBound(aArr)
                If Not .exists(aArr(i, 1)) Then
                   .Item(aArr(i, 1)) = aArr(i, 1)
                End If
            Next
            For Each ws In wb.Worksheets
                If ws.Name <> sh1 Then
                   aArr = ws.Range("a1").CurrentRegion
                   For i = UBound(aArr) To 2 Step -1
                       If Not .exists(aArr(i, 1)) Then
                           ws.Rows(i).Delete
                       End If
                   Next
                End If
            Next
        End With
    Next
EarlyExit:
    .ScreenUpdating = True
 End With
End Sub

If the last column in some rows are different does it matter? I want to see if I can get this to work for a similar situations with data. Where the number of column changes?

Have the document "up" the active one is the one that comes up when you click on Excel. In other words - while your looking at the Workbook in question - the one with 20 or 23 tabs! The code doesn't need to be in the active book but it must be in the module of a macro-enabled book (for 2007 and 2010 which you have).

Will the list be in both workbooks? In other words will each workbook have its own list to ompare with he other sheets?

Nope that wont matter

Well, when I ran it Sheet2 had more rows than Sheet1 - I assumed that they were duplicates since I traversed every cell in Sheet2 Row A???????