Comparing 2 datasets for reconciliation using VBA

[BigMo1987]

Hello all,

I am looking for a VBA code to reconcile two data sets in Sheet1 and Sheet2 (See attached report). Looking for qty differences between both sheets and identifying if a column A, B or C and have any discrepancies. Can anyone help?

Thank you in advance!

 

[Zot]

These statement are correct?
1) Data on Sheet1 and Sheet2 are not necessarily in same sequence.
2) List in Sheet1 and Sheet2 are not necessarily in same length.
3) You are comparing if Sheet1 A, B and C are matching with Sheet2 A, B, and C respectively regardless their row

Question:
1) Is it possible that more than 1 row in Sheet2 matched a row in Sheet1?
2) Are you interested to know which line has no match to Sheet1 in Sheet2?
Note on Q2: I think if you compare Sheet2 to Sheet1, the no match number would be different.

 

[BigMo1987]

Hello Zot,

These statement are correct?
1) Data on Sheet1 and Sheet2 are not necessarily in same sequence. Yes, they may not be in the same sequence
2) List in Sheet1 and Sheet2 are not necessarily in same length. Yes
3) You are comparing if Sheet1 A, B and C are matching with Sheet2 A, B, and C respectively regardless their row: Correct and calculate the difference between Column C in sheet1 and Column C in sheet2

Question:
1) Is it possible that more than 1 row in Sheet2 matched a row in Sheet1? No
2) Are you interested to know which line has no match to Sheet1 in Sheet2? Yes
Note on Q2: I think if you compare Sheet2 to Sheet1, the no match number would be different.

Hello Zot, Please see my response next to your question. Thank you in advance!

 

[Zot]

I wrote the difference in Sheet1 column D and highlight Yellow matching columns (A,B,C or just A,B if C is different)

Sub Compare_Difference()

Dim eRow1&, eRow2&
Dim cell1 As Range, cell2 As Range
Dim rngSht1 As Range, rngSht2 As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Application.ScreenUpdating = False

Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

' Get last row for each data on Sheet1 and Sheet2
eRow1 = ws1.Range("A1").End(xlDown).Row
eRow2 = ws2.Range("A1").End(xlDown).Row

' Define Range for each sheet
Set rngSht1 = ws1.Range("A2", "A" & eRow1)
Set rngSht2 = ws2.Range("A2", "A" & eRow2)

For Each cell1 In rngSht1
    For Each cell2 In rngSht2
        If cell2 = cell1 And cell2.Offset(0, 1) = cell1.Offset(0, 1) Then
            Select Case True
                Case ws2.Range("C" & cell2.Row) = ws1.Range("C" & cell1.Row)
                    ws2.Range("A" & cell2.Row, "C" & cell2.Row).Interior.ColorIndex = 6
                Case Else
                    ws2.Range("A" & cell2.Row, "B" & cell2.Row).Interior.ColorIndex = 6
                    ws1.Range("D" & cell1.Row) = ws2.Range("C" & cell2.Row) - ws1.Range("C" & cell1.Row)
            End Select
        End If
    Next
Next
    
Application.ScreenUpdating = True

End Sub

 

[BigMo1987]

I wrote the difference in Sheet1 column D and highlight Yellow matching columns (A,B,C or just A,B if C is different)

Sub Compare_Difference()

Dim eRow1&, eRow2&
Dim cell1 As Range, cell2 As Range
Dim rngSht1 As Range, rngSht2 As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Application.ScreenUpdating = False

Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

' Get last row for each data on Sheet1 and Sheet2
eRow1 = ws1.Range("A1").End(xlDown).Row
eRow2 = ws2.Range("A1").End(xlDown).Row

' Define Range for each sheet
Set rngSht1 = ws1.Range("A2", "A" & eRow1)
Set rngSht2 = ws2.Range("A2", "A" & eRow2)

For Each cell1 In rngSht1
    For Each cell2 In rngSht2
        If cell2 = cell1 And cell2.Offset(0, 1) = cell1.Offset(0, 1) Then
            Select Case True
                Case ws2.Range("C" & cell2.Row) = ws1.Range("C" & cell1.Row)
                    ws2.Range("A" & cell2.Row, "C" & cell2.Row).Interior.ColorIndex = 6
                Case Else
                    ws2.Range("A" & cell2.Row, "B" & cell2.Row).Interior.ColorIndex = 6
                    ws1.Range("D" & cell1.Row) = ws2.Range("C" & cell2.Row) - ws1.Range("C" & cell1.Row)
            End Select
        End If
    Next
Next
   
Application.ScreenUpdating = True

End Sub

Thank you so much Zot! Works as the way i needed

 

[BigMo1987]

I wrote the difference in Sheet1 column D and highlight Yellow matching columns (A,B,C or just A,B if C is different)

Sub Compare_Difference()

Dim eRow1&, eRow2&
Dim cell1 As Range, cell2 As Range
Dim rngSht1 As Range, rngSht2 As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Application.ScreenUpdating = False

Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

' Get last row for each data on Sheet1 and Sheet2
eRow1 = ws1.Range("A1").End(xlDown).Row
eRow2 = ws2.Range("A1").End(xlDown).Row

' Define Range for each sheet
Set rngSht1 = ws1.Range("A2", "A" & eRow1)
Set rngSht2 = ws2.Range("A2", "A" & eRow2)

For Each cell1 In rngSht1
    For Each cell2 In rngSht2
        If cell2 = cell1 And cell2.Offset(0, 1) = cell1.Offset(0, 1) Then
            Select Case True
                Case ws2.Range("C" & cell2.Row) = ws1.Range("C" & cell1.Row)
                    ws2.Range("A" & cell2.Row, "C" & cell2.Row).Interior.ColorIndex = 6
                Case Else
                    ws2.Range("A" & cell2.Row, "B" & cell2.Row).Interior.ColorIndex = 6
                    ws1.Range("D" & cell1.Row) = ws2.Range("C" & cell2.Row) - ws1.Range("C" & cell1.Row)
            End Select
        End If
    Next
Next
   
Application.ScreenUpdating = True

End Sub

Hi Zot, Are you able to add a code that can show the difference in sheet 1 as well? I may have differences in sheet 1 that's not in sheet2.

 

[Zot]

Hi Zot, Are you able to add a code that can show the difference in sheet 1 as well? I may have differences in sheet 1 that's not in sheet2.

I did not understand what you meant by that.

Do you mean something like in my note on Question 2?

The macro goes through list in Sheet1 and look in Sheet2 for matching. If you go through list in Sheet2 and look in Sheet1 for matching, it is different. Now for difference in C is Sheet2 - Sheet1.

The code can be revert by renaming ws1 to ws2, rng1 to rng2, etc.

Another option is to to combine the opposite macro code to run the opposite way in one go and use another color perhaps

 

[BigMo1987]

I meant this by adding this option: Another option is to to combine the opposite macro code to run the opposite way in one go and use another color perhaps

 

[Zot]

Something like this?

Sub Compare_Difference()

Dim eRow1&, eRow2&
Dim cell1 As Range, cell2 As Range
Dim rngSht1 As Range, rngSht2 As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Application.ScreenUpdating = False

Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

' Get last row for each data on Sheet1 and Sheet2
eRow1 = ws1.Range("A1").End(xlDown).Row
eRow2 = ws2.Range("A1").End(xlDown).Row

' Define Range for each sheet
Set rngSht1 = ws1.Range("A2", "A" & eRow1)
Set rngSht2 = ws2.Range("A2", "A" & eRow2)

ws1.Range("D1") = "Diff (Sht2 - Sht1)"
For Each cell1 In rngSht1
    For Each cell2 In rngSht2
        If cell2 = cell1 And cell2.Offset(0, 1) = cell1.Offset(0, 1) Then
            Select Case True
                Case ws2.Range("C" & cell2.Row) = ws1.Range("C" & cell1.Row)
                    ws2.Range("A" & cell2.Row, "C" & cell2.Row).Interior.ColorIndex = 6
                Case Else
                    ws2.Range("A" & cell2.Row, "B" & cell2.Row).Interior.ColorIndex = 6
                    ws1.Range("D" & cell1.Row) = ws2.Range("C" & cell2.Row) - ws1.Range("C" & cell1.Row)
            End Select
        End If
    Next
Next

ws2.Range("D1") = "Diff (Sht1 - Sht2)"
For Each cell2 In rngSht2
    For Each cell1 In rngSht1
        If cell1 = cell2 And cell1.Offset(0, 1) = cell2.Offset(0, 1) Then
            Select Case True
                Case ws1.Range("C" & cell1.Row) = ws2.Range("C" & cell2.Row)
                    ws1.Range("A" & cell1.Row, "C" & cell1.Row).Interior.ColorIndex = 42
                Case Else
                    ws1.Range("A" & cell1.Row, "B" & cell1.Row).Interior.ColorIndex = 42
                    ws2.Range("D" & cell2.Row) = ws1.Range("C" & cell1.Row) - ws2.Range("C" & cell2.Row)
            End Select
        End If
    Next
Next
    
Application.ScreenUpdating = True

 

[Zot]

I use Sheet index number such as Sheet(1), Sheet(2). It can be any number if you look in VBA explorer. You can use sheet name also like Sheet("Sheet1") or whatever name.