Compare two sheets using one column as reference and display difference - Using dictionary method

C

ChanchalSingh

New Member
Joined
May 29, 2022
Messages
8
Office Version
  1. 2013
Platform
  1. Windows
Hi, I am new to macro. I have a requirement where I need to compare 2 sheets. Functionality should work as below:

1. In sheet1 there is a unique id column and even in sheet2 we have unique id column
2. Assume Sheet1 has 30 rows of data and sheet2 has 50 rows of that.
3. Need to search each unique id from sheet1 and compare with sheet2, if unique id of sheet1 is found in sheet2 then that row data should be compared
4. If any cell data mismatch in that row then it should highlight in yellow/red in sheet1.(if possible show difference Sheet1:aaa nd Sheet2: bbb)
5. I am able to do this using for loop method but its taking too much time(30 min to process 10k records). So I want to achieve this using dictionary method to get results quickly.

Example:

Sheet1:
UniqueId ColA ColB ColC
Id1 10 aaa 10/10/2000
Id2 20 bbb 12/10/2000
Id3 20 ccc 10/11/2001

Sheet2:
UniqueId ColA ColB ColC
Id1 10 zzz 10/10/2000
Id4 20 ccc 10/11/2001
Id2 20 bbb 12/10/2000
Id3 10 ccc 20/11/2001

Ouput:
Sheet1:
UniqueId ColA ColB ColC
Id1 10 aaa 10/10/2000 ----> Id1 is matching with Sheet2 but ColumnB has mismatch so should be highlighted in sheet1(if possible show difference in same cell)
Id2 20 bbb 12/10/2000 ----> Id12 is matching with Sheet2 but no change in color as data is matching in both sheets for that id
Id3 20 ccc 20/03/2010 -----> Id3 is matching with Sheet2 but ColA and ColC data mismatch so should be highlighted in sheet1(if possible show difference in same cells)

Note: Id4 is not there in Sheet1 so we are not using it for any comparing and ignoring it.
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
this is not with a dictionary, i even think it should be quicker then with a dictionary.
It uses listobjects, so if you don't use them, it 'll be slightly different.
Differences can be added as comment or as an extra column aside your data
VBA Code: 
Sub Compairing()
     Dim iID, LO1, LO2
     t = Timer
     Set LO1 = Sheets("sheet1").ListObjects("TBL_1")
     iID = LO1.ListColumns("ID").Range.Column - LO1.Range.Column + 1
     arr1 = LO1.DataBodyRange.Value2
     ID1 = LO1.ListColumns("ID").DataBodyRange.Value

     Set LO2 = Sheets("sheet2").ListObjects("TBL_2")
     arr2 = LO2.DataBodyRange.Value2
     id2 = LO2.ListColumns("ID").DataBodyRange.Value

     LO1.DataBodyRange.Interior.Color = xlNone

     For i = 1 To UBound(arr1)
          r = Application.Match(arr1(i, iID), id2, 0)
          DoEvents
          If IsNumeric(r) Then
               For j = 1 To UBound(arr1, 2)
                    If arr1(i, j) <> arr2(i, j) Then LO1.DataBodyRange(i, j).Interior.ColorIndex = 3
               Next
          Else
               LO1.ListRows(i).Range.Interior.ColorIndex = 4
          End If
     Next
     MsgBox Timer - t
End Sub
 
Upvote 0
If you want to show the differences put this formula into the each row in any other column.

=IF(ISNA(MATCH($A2,Sheet2!$A:$A,0)),"err",IF($B2<>OFFSET(Sheet2!$A$1,MATCH($A2,Sheet2!$A:$A,0)-1,1),$B2&" <> "&OFFSET(Sheet2!$A$1,MATCH($A2,Sheet2!$A:$A,0)-1,1),"")&" "&IF($C2<>OFFSET(Sheet2!$A$1,MATCH($A2,Sheet2!$A:$A,0)-1,2),$C2&" <> "&OFFSET(Sheet2!$A$1,MATCH($A2,Sheet2!$A:$A,0)-1,2),"")&" "&IF($D2<>OFFSET(Sheet2!$A$1,MATCH($A2,Sheet2!$A:$A,0)-1,3),TEXT($D2,"dd/mm/yyyy") &" <> "&TEXT(OFFSET(Sheet2!$A$1,MATCH($A2,Sheet2!$A:$A,0)-1,3),"dd/mm/yyyy"),""))

Also put these conditional formatting rules in each cell in columns B, C and D respectively.

=IF(ISNA(MATCH($A2,Sheet2!$A:$A,0)),FALSE,IF($B2<>OFFSET(Sheet2!$A$1,MATCH($A2,Sheet2!$A:$A,0)-1,1),TRUE,FALSE))=TRUE

=IF(ISNA(MATCH($A2,Sheet2!$A:$A,0)),FALSE,IF($C2<>OFFSET(Sheet2!$A$1,MATCH($A2,Sheet2!$A:$A,0)-1,2),TRUE,FALSE))=TRUE

=IF(ISNA(MATCH($A2,Sheet2!$A:$A,0)),FALSE,IF($D2<>OFFSET(Sheet2!$A$1,MATCH($A2,Sheet2!$A:$A,0)-1,3),TRUE,FALSE))=TRUE

You will need to set the formatting.
 
Upvote 0
BSALV said:
this is not with a dictionary, i even think it should be quicker then with a dictionary.
It uses listobjects, so if you don't use them, it 'll be slightly different.
Differences can be added as comment or as an extra column aside your data
VBA Code: 
Sub Compairing()
     Dim iID, LO1, LO2
     t = Timer
     Set LO1 = Sheets("sheet1").ListObjects("TBL_1")
     iID = LO1.ListColumns("ID").Range.Column - LO1.Range.Column + 1
     arr1 = LO1.DataBodyRange.Value2
     ID1 = LO1.ListColumns("ID").DataBodyRange.Value

     Set LO2 = Sheets("sheet2").ListObjects("TBL_2")
     arr2 = LO2.DataBodyRange.Value2
     id2 = LO2.ListColumns("ID").DataBodyRange.Value

     LO1.DataBodyRange.Interior.Color = xlNone

     For i = 1 To UBound(arr1)
          r = Application.Match(arr1(i, iID), id2, 0)
          DoEvents
          If IsNumeric(r) Then
               For j = 1 To UBound(arr1, 2)
                    If arr1(i, j) <> arr2(i, j) Then LO1.DataBodyRange(i, j).Interior.ColorIndex = 3
               Next
          Else
               LO1.ListRows(i).Range.Interior.ColorIndex = 4
          End If
     Next
     MsgBox Timer - t
End Sub
Click to expand...
 
Upvote 0
I am getting error on line 3(Set LO1 = Sheets("sheet1").ListObjects)

Error details:
Run-time error '9':
Subscript out of range
 
Upvote 0
VBA Code: 
Option Explicit
Sub test()
Dim lr&, i&, j&, k&, rng
With Worksheets("Sheet2")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:D" & lr).Value
End With
With Worksheets("Sheet1")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To lr - 1
        For j = 1 To UBound(rng)
            If .Cells(i + 1, 1).Value = rng(j, 1) Then
                For k = 2 To 4
                    If .Cells(i + 1, k).Value <> rng(j, k) Then
                        .Cells(i + 1, k).Interior.Color = vbYellow
                        .Cells(i + 1, k + 4).Value = rng(j, k)
                    End If
                Next
                Exit For
            End If
        Next
    Next
End With
End Sub
Book1
ABCDEFGH
1UniqueIDColAColBColCColAColBColC
2Id110aaa10/10/2000zzz
3Id220bbb12/10/2000
4Id320ccc10/11/20011020/11/2001
Sheet1


Book1
ABCD
1UniqueIDColAColBColC
2Id110zzz10/10/2000
3Id420ccc10/11/2001
4Id220bbb12/10/2000
5Id310ccc20/11/2001
Sheet2
 
Upvote 0
Solution
bebo021999 said:
VBA Code: 
Option Explicit
Sub test()
Dim lr&, i&, j&, k&, rng
With Worksheets("Sheet2")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:D" & lr).Value
End With
With Worksheets("Sheet1")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To lr - 1
        For j = 1 To UBound(rng)
            If .Cells(i + 1, 1).Value = rng(j, 1) Then
                For k = 2 To 4
                    If .Cells(i + 1, k).Value <> rng(j, k) Then
                        .Cells(i + 1, k).Interior.Color = vbYellow
                        .Cells(i + 1, k + 4).Value = rng(j, k)
                    End If
                Next
                Exit For
            End If
        Next
    Next
End With
End Sub
Book1
ABCDEFGH
1UniqueIDColAColBColCColAColBColC
2Id110aaa10/10/2000zzz
3Id220bbb12/10/2000
4Id320ccc10/11/20011020/11/2001
Sheet1


Book1
ABCD
1UniqueIDColAColBColC
2Id110zzz10/10/2000
3Id420ccc10/11/2001
4Id220bbb12/10/2000
5Id310ccc20/11/2001
Sheet2
Click to expand...
bebo021999 said:
VBA Code: 
Option Explicit
Sub test()
Dim lr&, i&, j&, k&, rng
With Worksheets("Sheet2")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:D" & lr).Value
End With
With Worksheets("Sheet1")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To lr - 1
        For j = 1 To UBound(rng)
            If .Cells(i + 1, 1).Value = rng(j, 1) Then
                For k = 2 To 4
                    If .Cells(i + 1, k).Value <> rng(j, k) Then
                        .Cells(i + 1, k).Interior.Color = vbYellow
                        .Cells(i + 1, k + 4).Value = rng(j, k)
                    End If
                Next
                Exit For
            End If
        Next
    Next
End With
End Sub
Book1
ABCDEFGH
1UniqueIDColAColBColCColAColBColC
2Id110aaa10/10/2000zzz
3Id220bbb12/10/2000
4Id320ccc10/11/20011020/11/2001
Sheet1


Book1
ABCD
1UniqueIDColAColBColC
2Id110zzz10/10/2000
3Id420ccc10/11/2001
4Id220bbb12/10/2000
5Id310ccc20/11/2001
Sheet2
Click to expand...

Thanks a lot. Code is working perfectly fine with some changes minor changes. I tested with huge data and performance is really great. Thanks once again :)
 
Upvote 0
bebo021999 said:
VBA Code: 
Option Explicit
Sub test()
Dim lr&, i&, j&, k&, rng
With Worksheets("Sheet2")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:D" & lr).Value
End With
With Worksheets("Sheet1")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To lr - 1
        For j = 1 To UBound(rng)
            If .Cells(i + 1, 1).Value = rng(j, 1) Then
                For k = 2 To 4
                    If .Cells(i + 1, k).Value <> rng(j, k) Then
                        .Cells(i + 1, k).Interior.Color = vbYellow
                        .Cells(i + 1, k + 4).Value = rng(j, k)
                    End If
                Next
                Exit For
            End If
        Next
    Next
End With
End Sub
Book1
ABCDEFGH
1UniqueIDColAColBColCColAColBColC
2Id110aaa10/10/2000zzz
3Id220bbb12/10/2000
4Id320ccc10/11/20011020/11/2001
Sheet1


Book1
ABCD
1UniqueIDColAColBColC
2Id110zzz10/10/2000
3Id420ccc10/11/2001
4Id220bbb12/10/2000
5Id310ccc20/11/2001
Sheet2
Click to expand...
@ChanchalSingh Thank you very very MUCH. This has also helped me tremendously!
 
Upvote 0
You must log in or register to reply here.

Similar threads

Asbestos_Jen
  • Question Question
Compare multiple parameters of samples to reference values (Excel 2007)
Replies
3
Views
337
Asbestos_Jen
Asbestos_Jen
R
  • Question Question
Excel VBA match based on concatenating two inputs and comparing to two concatenated ranges
Replies
1
Views
1K
tonyyy
tonyyy
L
  • Question Question
vba compare between two sheets and highlight new items
Replies
2
Views
398
leap out
L
J
  • Question Question
Compare two worksheets and report differences into third worksheet
Replies
0
Views
2K
JedHass
J
H
  • Question Question
macro for 5000 rows for subtraction two columns between two sheets
Replies
0
Views
383
Hasson
H

Forum statistics

Threads
1,223,099
Messages
6,170,108
Members
452,302
Latest member
TaMere

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top