Code to match two sheets and display differences display, matches, following, between, example

andy

Hi,
Right now i'm busy with my finishing school-project. Hopefully you guys can help me to solve my problem! I want to create a macro to do the following:
I've two sheets. Sheet1 is housing data for more than 5000 rows and sheet2 for about 7000 rows. I want to make a macro that matches the two sheets and sheet3 needs to display the differences between both sheets. I made an example:
Sheet1
Column A Column B Column C Column D Column E Column F
Date ID-number Employee# Name Account# Amount
1-1-2007 AD1010345 V-001-BVC Ben 75210201 $7.000,00
28-1-2007 FR5289889 A-005-JRD John 25941230 $6.500,00
2-2-2007 HL1589789 G-004-THO Ted 56214790 $4.500,00
5-2-2007 BN7364103 C-075-POL Peter 21586466 $7.000,00
11-3-2007 TG5897466 E-014-CRY Chris 46782647 $3.500,00
etc.
Sheet2
Column A Column B Column C Column D Column E Column F
Date ID-number Employee# Name Account# Amount
1-1-2007 AD1010345 V-001-BVC Ben 75210201 $7.000,00
28-1-2007 FR5289889 A-005-JRD John 25941230 $6.000,00
2-2-2007 HL1589789 G-004-THO Ted 56214790 $4.500,00
1-3-2007 WF3189157 D-311-MDG Matt 85961432 $5.500,00
11-3-2007 TG5897466 E-014-CRY Chris 46782647 $3.500,00
etc.
The macro has to match both sheets and needs to use ID-number, Employee#, Name, Account# and Amount as criteria for matching the data! This will give the following result, as its create a third sheet in the active worokbook:
Sheet3
Column A Column B Column C Column D Column E Column F
Date ID-number Employee# Name Account# Amount
5-2-2007 BN7364103 C-075-POL Peter 21586466 $7.000,00
28-1-2007 FR5289889 A-005-JRD John 25941230 $6.000,00
1-3-2007 WF3189157 D-311-MDG Matt 85961432 $5.500,00
I hope you can help me out guys.
Lots of thanks!

Cross-posted at VBAExpres forum/showthread.php?t=19607


Code:
Sub test()
Dim a, i As Long, ii As Integer, z As String, y, n As Long
a = Sheets("sheet1").Range("a1").CurrentRegion.Resize(,6).Value
With CreateObject("Scripting.Dictionary")   .CompareMode = vbTextCompare   For i = 2 To UBound(a,1)       z = Join(Array(a(i,2),a(i,3),a(i,4),a(i,5),a(i,6)),";")       If Not .exists(z) Then .add z, Array(a(i,1),a(i,2),a(i,3),a(i,4),a(i,5),a(i,6))   Next   a = Sheets("sheet2").Range("a1").CurrentRegion.Resize(,6).Value   For i = 2 To UBound(a,1)       z = Join(Array(a(i,2),a(i,3),a(i,4),a(i,5),a(i,6)),";")       If Not .exists(z) Then.add z, Array(a(i,1),a(i,2),a(i,3),a(i,4),a(i,5),a(i,6))       Else.remove(z)       End If   Next   y = .items : n = .count
End With
With Sheets("sheet3").Range("a1")   .CurrentRegion.ClearContents   .Resize(,6).Value = [{"Date","ID-number","Employee#","Name","Account#","Amount"}]   If n > 0 Then       .Offset(1).Resize(n, 6).Value = Application.Transpose(Application.Transpose(y))   End If
End With
End SubHi Jindon,
Lots of thanks for your reply!
It works great!!
Greatings!
Keep up your posting

Hi Guys,
I've one more question. Is it possible to add a line in the vba-code to diplay in sheet 3 column G the original sheetname!
Thanks

1) change

Code:
If Not .exists(z) Then .add z, Array(a(i,1),a(i,2),a(i,3),a(i,4),a(i,5),a(i,6))
to

Code:
If Not .exists(z) Then .add z, Array(a(i,1),a(i,2),a(i,3),a(i,4),a(i,5),a(i,6), "Sheet1")
2) change

Code:       If Not .exists(z) Then.add z, Array(a(i,1),a(i,2),a(i,3),a(i,4),a(i,5),a(i,6))       Else
to

Code:       If Not .exists(z) Then.add z, Array(a(i,1),a(i,2),a(i,3),a(i,4),a(i,5),a(i,6), "Sheet2")       Else
3) change

Code:   .Resize(,6).Value = [{"Date","ID-number","Employee#","Name","Account#","Amount"}]   If n > 0 Then       .Offset(1).Resize(n, 6).Value = Application.Transpose(Application.Transpose(y))   End If
to

Code:   .Resize(,7).Value = [{"Date","ID-number","Employee#","Name","Account#","Amount","Sheet Name"}]   If n > 0 Then       .Offset(1).Resize(n, 7).Value = Application.Transpose(Application.Transpose(y))   End IfHi Jindon,
It works great! Thanks for all your help!!!!!
Greetings