Sub GetFilesAndMerge()
' Keyboard Shortcut: Ctrl+Shift+V
'First-off setting the current workbook in a workbook variable so that after opening First & Second Files, The Data is Merged in this File instead of any other File
'https://stackoverflow.com/questions/12386448/vba-changing-active-workbook
Dim CurrentWorkBook As Workbook
Set CurrentWorkBook = ActiveWorkbook
'Following is the code I searched for on the internet.
'https://www.mrexcel.com/forum/excel-questions/551609-vba-how-open-file-input-user-via-browse.html
'The Following Code is Going to Ask User To Select The First File
Dim ListFileNameandPath As Variant, LWB As Workbook
ListFileNameandPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select First File")
If ListFileNameandPath = False Then Exit Sub
Set LWB = Workbooks.Open(ListFileNameandPath)
'The Following Code is Going to Ask User To Select The Second File
Dim ModelFileNameandPath As Variant, MWB As Workbook
ModelFileNameandPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select Second File")
If ModelFileNameandPath = False Then Exit Sub
Set MWB = Workbooks.Open(ModelFileNameandPath)
'Following is the code that I received from Mick
'https://www.mrexcel.com/forum/excel-questions/1045163-merge-data-two-tables-based-lookup-value.html#post5017132
Dim Rng As Range, Dn As Range, n As Long, T1 As Range, T2 As Range, ac As Long
Dim Ray() As Variant, c As Long, R As Range
With LWB.Sheets("sheet1")
Set T1 = .Range("A1:A7") 'Change Range address as required
End With
With MWB.Sheets("sheet1")
Set T2 = .Range("A1:A7") 'Change Range address as required
End With
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In T2
If Not .exists(Dn.Value) Then
.Add Dn.Value, Dn
Else
Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
End If
Next
For Each Dn In T1
If .exists(Dn.Value) Then
For Each R In .Item(Dn.Value)
c = c + 1
ReDim Preserve Ray(1 To 7, 1 To c)
For ac = 1 To 7
If ac <= 4 Then
Ray(ac, c) = Dn(, ac)
Else
Ray(ac, c) = R.Offset(, ac - 4).Value
End If
Next ac
Next R
End If
Next Dn
End With
'Activating the workbook where the data will be merged. The variable CurrentWorkBook was defined at the start of the script
'https://stackoverflow.com/questions/12386448/vba-changing-active-workbook
CurrentWorkBook.Activate
With ActiveSheet.Range("A1").Resize(c, 7)
.Value = Application.Transpose(Ray)
.Borders.Weight = 2
.Columns.AutoFit
.HorizontalAlignment = xlCenter
End With
LWB.Close savechanges:=False 'or false
MWB.Close savechanges:=False 'or false
End Sub
