Fill uncommon data in 2 columns

hcova

New Member
Joined
Jul 29, 2010
Messages
4
Dear sir:
I would like to write a piece of VBA code to compare 2 tables and then fill them with the differences (both with the same range length)
In the left side of the below picture you will find two tables to be compared. In this case the tables have a different lenght.
In the right side you will find the tables I need. As you can see in these 2 tables they have the same lenght and they include the differences between them.

1613960202413.png


Finally how could I write a VBA code for more than 2 tables?
Best Regards
Hernan
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,194
Office Version
  1. 2016
Platform
  1. Windows
Just what do you meant by this?
Finally how could I write a VBA code for more than 2 tables?

Do you mean if you have more than 2 tables with different length?
 

hcova

New Member
Joined
Jul 29, 2010
Messages
4
Dear Zot.
First I need a VBA code to solve the problem with 2 tables with different lenght as it is shown in the picture.
Once solved this, I would like to know what I need to modify in that VBA code to apply it in more than 2 tables (as a general case)
I hope it solve your question.
Best regards and thanks.
Hernan
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,194
Office Version
  1. 2016
Platform
  1. Windows
Sorry. I was too busy rushing with my work, being the only person calculating process cost to manufacture thing :cry:

To get to the same sequence like in your example is mind twisting (at least for me 😅). I guess if more than 2 lists, then just need to compare against two at a time.
This works for the example but I have not done extensive testing. Hope it works just fine

VBA Code:
Sub Compare_Sync()

Dim n&, nDiff&
Dim key, keyRef
Dim cell As Range
Dim rngList1 As Range, rngList2 As Range
Dim rngListRef As Range, rngList As Range
Dim dNameRef As Object, dName As Object

Set dNameRef = CreateObject("Scripting.Dictionary")
Set dName = CreateObject("Scripting.Dictionary")
Set rngList1 = Range("A2", "A6")
Set rngList2 = Range("D2", "D9")

Application.ScreenUpdating = False

' Fill dictionaries
If rngList1.Count > rngList2.Count Then
    Set rngListRef = rngList1
    Set rngList = rngList2
Else
    Set rngListRef = rngList2
    Set rngList = rngList1
End If

For Each cell In rngListRef
    dNameRef.Add cell.Value, cell.Row & " " & cell.Offset(0, 1)
Next
For Each cell In rngList
    dName.Add cell.Value, cell.Row & " " & cell.Offset(0, 1)
Next

' Write result
Range("A1", "B1").Copy Range("H1")
Range("D1", "E1").Copy Range("K1")

n = 1
For Each key In dName
    If dNameRef.Exists(key) Then
        Result = Split(dName(key))
        ResultRef = Split(dNameRef(key))
        Select Case True
            Case Result(0) = ResultRef(0)
                n = n + 1
                Range("H" & n) = key
                Range("I" & n) = Result(1)
                Range("K" & n) = key
                Range("L" & n) = ResultRef(1)
                dName.Remove key
                dNameRef.Remove key
            Case Else
                nDiff = 0
                nDiff = ResultRef(0) - Result(0)
                For Each keyRef In dNameRef
                    If keyRef = key Then
                        n = n + 1
                        ResultRef = Split(dNameRef(keyRef))
                        Range("H" & n) = key
                        Range("I" & n) = Result(1)
                        Range("K" & n) = key
                        Range("L" & n) = ResultRef(1)
                        dName.Remove key
                        dNameRef.Remove key
                        Exit For
                    Else
                        n = n + 1
                        Result = Split(dName(key))
                        ResultRef = Split(dNameRef(keyRef))
                        Range("H" & n) = keyRef
                        Range("I" & n) = 0
                        Range("K" & n) = keyRef
                        Range("L" & n) = ResultRef(1)
                        dNameRef.Remove keyRef
                    End If
                Next
        End Select
    Else
        n = n + 1
        Result = Split(dName(key))
        Range("H" & n) = key
        Range("I" & n) = Result(1)
        Range("K" & n) = key
        Range("L" & n) = 0
        dName.Remove key
    End If
Next
        
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,130,240
Messages
5,641,038
Members
417,190
Latest member
Sdwd76

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
Top