Forum Discussion
ShadowHawk26
Nov 01, 2024Copper Contributor
Macro/VBA to merge to documents
Hi All, Struggling to find VBA/Macro code that will suit my needs. I have a file that will become the parent file for a new system. In this file there is roughly 1600 rows already filled out. Th...
NikolinoDE
Nov 01, 2024Platinum Contributor
Maybe this VBA approach will help you, if not please just ignore it.
Sub MergeFiles()
Dim wsParent As Worksheet
Dim wsDonor As Worksheet
Dim lastRowParent As Long, lastRowDonor As Long
Dim i As Long, j As Long, insertRow As Long
Dim donorCriteria1 As Variant, donorCriteria2 As Variant, donorCriteria3 As Variant
Dim donorInfo1 As Variant, donorInfo2 As Variant
Dim parentCriteria1 As Variant, parentCriteria2 As Variant, parentCriteria3 As Variant
' Set references to the worksheets
Set wsParent = ThisWorkbook.Sheets("ParentSheetName") ' Adjust the sheet name as necessary
Workbooks.Open "C:\path\to\DonorFile.xlsx" ' Change to the actual path of the donor file
Set wsDonor = Workbooks("DonorFile.xlsx").Sheets("DonorSheetName") ' Adjust the sheet name as necessary
' Find the last rows in both sheets
lastRowParent = wsParent.Cells(wsParent.Rows.Count, "A").End(xlUp).Row
lastRowDonor = wsDonor.Cells(wsDonor.Rows.Count, "A").End(xlUp).Row
' Loop through each row in the parent file
For i = 2 To lastRowParent ' Assuming headers in the first row
parentCriteria1 = wsParent.Cells(i, "A").Value
parentCriteria2 = wsParent.Cells(i, "B").Value
parentCriteria3 = wsParent.Cells(i, "C").Value
' Loop through the donor file to find matching rows
For j = 2 To lastRowDonor
donorCriteria1 = wsDonor.Cells(j, "A").Value
donorCriteria2 = wsDonor.Cells(j, "B").Value
donorCriteria3 = wsDonor.Cells(j, "C").Value
If parentCriteria1 = donorCriteria1 And parentCriteria2 = donorCriteria2 And parentCriteria3 = donorCriteria3 Then
' Insert a new row in the parent file
insertRow = i + 1
wsParent.Rows(insertRow).Insert Shift:=xlDown
' Copy data from donor to the new row in parent
donorInfo1 = wsDonor.Cells(j, "D").Value
donorInfo2 = wsDonor.Cells(j, "E").Value
wsParent.Cells(insertRow, "A").Value = parentCriteria1
wsParent.Cells(insertRow, "B").Value = parentCriteria2
wsParent.Cells(insertRow, "C").Value = parentCriteria3
wsParent.Cells(insertRow, "D").Value = donorInfo1
wsParent.Cells(insertRow, "E").Value = donorInfo2
' Adjust last row of parent as a new row was inserted
lastRowParent = lastRowParent + 1
' Move to the next row in the parent file after insertion
i = i + 1
End If
Next j
Next i
' Close the donor file without saving
Workbooks("DonorFile.xlsx").Close SaveChanges:=False
MsgBox "Merging Completed!"
End Sub
VBA code is untested backup your file first.
My answers are voluntary and without guarantee!
Hope this will help you.
- ShadowHawk26Nov 01, 2024Copper Contributor
Thank you for your help. It seems some of the image has been cut off.