Fill uncommon data in 2 columns

[hcova]

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.

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

 

[Zot]

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]

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]

Sorry. I was too busy rushing with my work, being the only person calculating process cost to manufacture thing

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

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