Match Multiple Threads of Data

[brandonmcg]

I have a scenario where I have one to three borrowers on a specific loan number. About 10,000 loans in total.
List # 1
Three headers
Borrower Loan Number Borrower Name Borrower ID
123456789 Bob Smith 111111111
123456789 Mary Smith 222222222
987654321 Gary Jones 333333333
963852741 Tom Jackson 444444444
963852741 Jill Jackson 555555555
963852741 Barry Jackson 666666666

Each Borrower ID is Unique.

I have a second sheet with the same information but it is from a different source.

I need to compare sheet one to sheet two making sure I match the loan numbers and Borrower ID's to each other.

I need to find where the Borrower ID does NOT match the other sheets Borrower ID.

Loan numbers must match to each other
The names may not always match exactly because they are from different sources and can be different from one another.
One report might say Mary Smith and the other Might say Mary L Smith. So they will be similar but not always exact.

I have to match each list to each other to show the work. Some how I need to see the exceptions or where there is not a match.


First Spreadsheet Second Spreadsheet
123456789 Bob Smith 111111111 = Match 123456789 Bob Smith 111111111 = Match
123456789 Mary Smith 222222222 = No Match 123456789 Mary Smith 222222223 = No Match
987654321 Gary Jones 333333333
963852741 Tom Jackson 444444444
963852741 Jill Jackson 555555555
963852741 Barry Jackson 666666666

Make sense?

 

[JLGWhiz]

Copy this to code module1

Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
    With sh1
        For Each c In .Range("C2", .Cells(Rows.Count, 3).End(xlUp))
            Set fn = sh2.Range("C:C").Find(c.Value, , xlValues, xlWhole)
                If Not fn Is Nothing Then
                    If c.Offset(, -2).Value = fn.Offset(, -2).Value Then
                        c.Offset(, 1) = "Match"
                        fn.Offset(, 1) = "Match"
                    End If
                End If
        Next
    End With
    With sh2
        .UsedRange.AutoFilter 4, "<>"
            For Each c In Intersect(.UsedRange.Offset(2), .Range("C:C")).SpecialCells(xlCellTypeVisible)
                If c <> "" Then
                    Set fn = sh1.Range("C:c").Find(c.Value, , xlValues, xlWhole)
                    If Not fn Is Nothing Then
                        If c.Offset(, -2).Value = fn.Offset(, -2).Value Then
                            c.Offset(, 1) = "Match"
                            fn.Offset(, 1) = "Match:"
                        End If
                    End If
                End If
            Next
        .AutoFilterMode = False
    End With
    Intersect(sh1.UsedRange, sh1.Columns(4)).SpecialCells(xlCellTypeBlanks).Interior.Color = vbRed
    Intersect(sh2.UsedRange, sh2.Columns(4)).SpecialCells(xlCellTypeBlanks).Interior.Color = vbRed
End Sub

 

[brandonmcg]

Thank you! I will give it a try. Thank you again!

 

[JLGWhiz]

You're welcome,
Regards, JLG