Comparison for Reconciliation

[Sandler]

Dear Friends,

I have information in columns A:C that I need to compare to columns F:G.

Column A is a Position (Text), Column B is a number, Column C is a Name (text).
Column F is a Position (Text), Column G is a number, Column H is a Name (text).

I need the script to look at the first set of info (starts in row 3, will be A3:C3).
If a match is found in a specific row in Columns F:H, I need it to delete both piece of info.
For example if in A3:C3, an exact match is found in F10:H10, then I need those 2 ranges to be deleted.

If a match is not found then, I need it to go to the next set of information.

Thanks in advance :)

[mdmackillop]

Can you mock up a file and post it to save responders each making their own?

[Sandler]

20345

Thanks mdmackillop. The top part of the picture is the original information. The bottom is what the results would be. In the bottom part I also sorted Columns A:C by Column A and Columns F:H, by Column F. This is just to bring the information upwards.

Thanks.

[mdmackillop]

Can you post a file, not a picture. Go Advanced / Manage Attachments

[Sandler]

Please see attachment20348

[Sandler]

Bump...

[mdmackillop]

Sub Test()
Dim LRw As Long
Dim arr()
Dim dic1, dic2

Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")

LRw1 = Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To LRw1
dic1.Add i, Cells(i, 1) & "#" & Cells(i, 2) & "#" & Cells(i, 3)
Next i
LRw2 = Cells(Rows.Count, 6).End(xlUp).Row
For i = 3 To LRw2
dic2.Add i, Cells(i, 6) & "#" & Cells(i, 7) & "#" & Cells(i, 8)
Next i

For i = LRw1 To 3 Step -1
dup = False
For Each kk In dic2.keys
If dic1(i) = dic2(kk) Then
Cells(kk, 6).Resize(, 3).ClearContents
dup = True
End If
Next kk
If dup Then Cells(i, 1).Resize(, 3).Delete shift:=xlUp
Next i
For i = LRw2 To 3 Step -1
If Cells(i, 6) = "" Then Cells(i, 6).Resize(, 3).Delete shift:=xlUp
Next i
End Sub

[Sandler]

Wow, bless you and bless Scotland.

Worked like a charm!

[Sandler]

Can I ask someone to put detailed comments in the vba code above? It works great and I would really like to understand how it works. I understand the LRw1 = Cells(Rows.Count, 1).End(xlUp).Row is looking at the first set of information and LRw2 = Cells(Rows.Count, 6).End(xlUp).Row is looking at the second set. I am unfamiliar with the scripting dictionary and the reason behind the hast tags when we add dic1 or dic2. I never really understood the resize.

Thanks in advance :)

[mdmackillop]

For Dictionaries, have a read of this (https://excelmacromastery.com/vba-dictionary/)

Resize expands a range to a different area. In this case, from 1 cell to 3 cells horizontally.
Instead of Cells(i, 1).Resize(, 3) I might have used Range(Cells(i,1), Cells(i,3))

Range("A1").Resize(4,4) => Range("A1:D4")


The # is used as a separator when joining cells to avoid accidental duplicates
eg join 123, 456, 789 =>123456789 : with separator 123#456#789
join 12, 345, 6789 =>123459789 : with separator 12#345#6789





Sub Test() Dim LRw As Long
Dim arr()
Dim dic1, dic2

Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")

LRw1 = Cells(Rows.Count, 1).End(xlUp).Row
'Add row number as key and concatenated cells as value; Area1
For i = 3 To LRw1
dic1.Add i, Cells(i, 1) & "#" & Cells(i, 2) & "#" & Cells(i, 3)
Next i
LRw2 = Cells(Rows.Count, 6).End(xlUp).Row
'Add row number as key and concatenated cells as value; Area2
For i = 3 To LRw2
dic2.Add i, Cells(i, 6) & "#" & Cells(i, 7) & "#" & Cells(i, 8)
Next i

'Loop through keys from last to first in Area1
For i = LRw1 To 3 Step -1
dup = False
For Each kk In dic2.keys
If dic1(i) = dic2(kk) Then
' If Dup found, clear Area2 cells
Cells(kk, 6).Resize(, 3).ClearContents
'Set flag value
dup = True
End If
Next kk
'If dup found, delete row from Area1
If dup Then Cells(i, 1).Resize(, 3).Delete shift:=xlUp
Next i
'Loop through Area2 from bottom and delete blank cells
For i = LRw2 To 3 Step -1
If Cells(i, 6) = "" Then Cells(i, 6).Resize(, 3).Delete shift:=xlUp
Next i
End Sub

[Sandler]

Very Informative. Thanks Again :)