Merge two files and remove duplicates

[YasserKhalil]

Hello everyone
I have two files 1.xlsx and 2.xlsx and need to merge data in both files relying on ID field
Sometimes some IDs are unique in the files and sometimes IDs are common (existing in both files)

I have uploaded Output file so as to see the desired output (the results are sorted by ID)
I need a macro to be put in Output file and deal with data from 1 and 2 files when they are closed
Thanks advanced for help

[mana]

Option Explicit


Sub test()
Dim dic As Object
Dim p As String
Dim i As Long
Dim s, it, n As Long

Set dic = CreateObject("scripting.dictionary")

p = ThisWorkbook.Path

With Workbooks.Open(p & "\1.xlsx").Sheets(1)
With .Cells(1).CurrentRegion
For i = 1 To .Rows.Count
s = .Cells(i, 1).Value
If Not dic.exists(s) Then
Set dic(s) = CreateObject("system.collections.arraylist")
dic(s).Add s
dic(s).Add .Cells(i, 2).Value
dic(s).Add .Cells(i, 3).Value
dic(s).Add Empty
End If
Next
End With
.Parent.Close False
End With

With Workbooks.Open(p & "\2.xlsx").Sheets(1)
With .Cells(1).CurrentRegion
For i = 1 To .Rows.Count
s = .Cells(i, 1).Value
If Not dic.exists(s) Then
Set dic(s) = CreateObject("system.collections.arraylist")
dic(s).Add s
dic(s).Add Empty
dic(s).Add Empty
Else
dic(s).removeat 3
End If
dic(s).Add .Cells(i, 3).Value
Next
End With
.Parent.Close False
End With

With Cells(1)
.CurrentRegion.ClearContents
For Each it In dic.items
.Offset(n).Resize(, 4).Value = it.toarray
n = n + 1
Next
.Sort .Columns(1), Header:=xlYes
End With

End Sub

[YasserKhalil]

Thank you very much Mr. Mana for this great code ..
I have noticed some incorrect results
Here's a snapshot of the differences between expected and code results
19536

[mana]

Option Explicit


Sub test2()
Dim dic As Object
Dim p As String
Dim i As Long
Dim s, it, n As Long

Set dic = CreateObject("scripting.dictionary")

p = ThisWorkbook.Path

With Workbooks.Open(p & "\1.xlsx").Sheets(1)
With .Cells(1).CurrentRegion
For i = 1 To .Rows.Count
s = .Cells(i, 1).Value
If Not dic.exists(s) Then
Set dic(s) = CreateObject("system.collections.arraylist")
dic(s).Add s
dic(s).Add .Cells(i, 2).Value
dic(s).Add .Cells(i, 3).Value
dic(s).Add Empty
End If
Next
End With
.Parent.Close False
End With

With Workbooks.Open(p & "\2.xlsx").Sheets(1)
With .Cells(1).CurrentRegion
For i = 1 To .Rows.Count
s = .Cells(i, 1).Value
If Not dic.exists(s) Then
Set dic(s) = CreateObject("system.collections.arraylist")
dic(s).Add s
dic(s).Add .Cells(i, 2).Value
dic(s).Add Empty
Else
If dic(s)(1) = "" Then
dic(s).removeat 1
dic(s).Insert 2, .Cells(i, 2).Value
End If
dic(s).removeat 3
End If
dic(s).Add .Cells(i, 3).Value
Next
End With
.Parent.Close False
End With

With Cells(1)
.CurrentRegion.ClearContents
For Each it In dic.items
.Offset(n).Resize(, 4).Value = it.toarray
n = n + 1
Next
.Sort .Columns(1), Header:=xlYes
End With

End Sub

[YasserKhalil]

That's amazing and fascinating Mr. Mana
Thank you very very much for this great solution
Best Regards