Migrate data from one workbook to another workbook using VBA

Wanted to extract matching data based on a cell from one workbook to another workbook when there is a match.

On the New Data there is code to migrate the data but for some reason the data is not matching up...these are highlighted in yellow in the New data file.  Those in yellow should be identical to the Old data that is being migrated from.

On column A, row 37 for example part number 100-109 on the New Data file should be exactly the same as 100-109 from the Old data when there is a match.

It appears that when the New Data file changes....meaning part numbers in column A get either deleted or added it no longer matches up when migrating the data.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Hi Luis,

Please give this a try and see if you are getting the correct output now.

Sub getMatchingDataFromOldFile()
Dim wbNew As Workbook, wbOld As Workbook
Dim wsNew As Worksheet, wsOld As Worksheet
Dim sFile, r
Dim slr As Long, i As Long, lr As Long
Dim arrNew, arrOld, LookupArr, oldIR()

Application.ScreenUpdating = False

Set wbNew = ThisWorkbook

sFile = Application.GetOpenFilename(FileFilter:="Excel Workbooks ,*.xls*", Title:="Open Old Data File", MultiSelect:=False)
If sFile = False Then
    MsgBox "You didn't select the Old Data File", vbExclamation, "Action Cancelled By User!"
    Exit Sub
End If
Set wbOld = Workbooks.Open(sFile)

For Each wsNew In wbNew.Sheets
    slr = wsNew.Cells(Rows.Count, 1).End(xlUp).Row
    arrNew = wsNew.Range("A2:A" & slr).Value
    ReDim oldIR(1 To UBound(arrNew, 1), 1 To 10)
    Set wsOld = getOldSheet(wsNew, wbOld)
    If Not wsOld Is Nothing Then
        lr = wsOld.Cells(Rows.Count, 1).End(xlUp).Row
        arrOld = wsOld.Range("A1").CurrentRegion.Value
        LookupArr = wsOld.Range("A1:A" & lr).Value
        For i = 1 To UBound(arrNew, 1)
        If i = 36 Then Stop
            r = Application.Match(arrNew(i, 1), LookupArr, 0)
            If Not IsError(r) Then
                oldIR(i, 1) = arrOld(r, 9)
                oldIR(i, 2) = arrOld(r, 10)
                oldIR(i, 3) = arrOld(r, 11)
                oldIR(i, 4) = arrOld(r, 12)
                oldIR(i, 5) = arrOld(r, 13)
                oldIR(i, 6) = arrOld(r, 14)
                oldIR(i, 7) = arrOld(r, 15)
                oldIR(i, 8) = arrOld(r, 16)
                oldIR(i, 9) = arrOld(r, 17)
                oldIR(i, 10) = arrOld(r, 18)
            End If
        Next i
        wsNew.Range("I2").Resize(UBound(oldIR), 10).Value = oldIR
        wsNew.Range("I2").Resize(UBound(oldIR), 10).WrapText = False
    End If
    Set wsOld = Nothing
    lr = 0
Next wsNew
wbOld.Close False
Application.ScreenUpdating = True
MsgBox "Data has been copied from Old Data File successfully.", vbInformation, "Done!"
End Sub

Function getOldSheet(ByVal wsN As Worksheet, ByVal wb As Workbook) As Worksheet
Dim ws As Worksheet
For Each ws In wb.Sheets
    If ws.Name = wsN.Name Then
        Set getOldSheet = ws
        Exit For
    End If
Next ws
End Function

Open in new window

LUIS FREUNDAuthor Commented:
Hi Neeraj,

I get an error at this line of code...highlighted in yellow

If i = 36 Then Stop
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Ah... so sorry! I added that line to debug and forgot to delete.
Just delete that line and code will work fine then.

Let me know if you have trouble deleting that line.
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Don't worry. Here is the tweaked file.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LUIS FREUNDAuthor Commented:
LUIS FREUNDAuthor Commented:
Thank you so much....works great!
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Luis!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.