asked on

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.
C--Users-lfreund-Downloads-OLD-DATA.xlsx
C--Users-lfreund-Downloads-C-NEW-DA.xlsm

Subodh Tiwari (Neeraj)

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

C--Users-lfreund-Downloads-C-NEW-DA.xlsm

LUIS FREUND

ASKER

Hi Neeraj,

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

If i = 36 Then Stop

Subodh Tiwari (Neeraj)

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.

ASKER CERTIFIED SOLUTION

Subodh Tiwari (Neeraj)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

LUIS FREUND

ASKER

Awesome!

LUIS FREUND

ASKER

Thank you so much....works great!

Subodh Tiwari (Neeraj)

You're welcome Luis!