Matching Records in two separate spreadsheets.

[DPC11]

I have two spreadsheets and each of them have Name, Address, City, State and Zip columns along with some other columns.

I want to highlight rows in spreadsheet A which have a matching name, address, city, state and zip in spreadsheet B.

Your help is highly appreciated.

 

[igold]

Hi DPC11,

I am a little confused with your terminology. The word "spreadsheet" can be ambiguous.

Do you have two different workbooks or do you have two different worksheets within the same workbook.

If it is two different workbooks then you would have to supply us with the names, paths, and worksheets of the two workbooks.

If it is two different worksheets within the same workbook then see below:

The below code assumes that spreadsheet A is named Sheet1 and spreadsheet B is named Sheet2. Additionally, the code assumes that the headers: Name, Address, City, State and Zip are in Cells A1:E1 on both sheets and are identical. The additional columns that you mention are irrelevant.

Sub FindDupes()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim iRange As Range
    Dim FinalRow As Long, FinalCol As Long
    Dim FoundCount As Long
    
    Application.ScreenUpdating = False
    Set ws1 = Worksheets("Sheet1")
    ws1.Activate
        
    ' Set up the criteria range
    Set ws2 = Worksheets("Sheet2")
    FinalRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    ws2.Cells(1, 1).Resize(FinalRow, 5).Name = "OutList"
    
    ' set up the input range
    FinalRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    FinalCol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
    Set iRange = ws1.Cells(1, 1).Resize(FinalRow, FinalCol)
    
    ' Find the items to Remove
    iRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("OutList"), Unique:=False
        
    FoundCount = iRange.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    If FoundCount = 0 Then
        ws1.ShowAllData
        MsgBox "No Duplicates Found."
        Exit Sub
    End If
    
    
    ws1.Cells(2, 1).Resize(FinalRow - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.Interior.Color = vbYellow
    ws1.ShowAllData
    ws1.Cells(1, 1).Select
    MsgBox FoundCount & " Duplicate Addresses Found."
    Application.ScreenUpdating = True
End Sub

HTH

igold