• Status: Solved
  • Priority: High
  • Security: Public
  • Views: 56
  • Last Modified:

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
0
LUIS FREUND
Asked:
LUIS FREUND
  • 4
  • 3
1 Solution
 
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

C--Users-lfreund-Downloads-C-NEW-DA.xlsm
0
 
LUIS FREUNDAuthor Commented:
Hi Neeraj,

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

If i = 36 Then Stop
0
 
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.
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Don't worry. Here is the tweaked file.
C--Users-lfreund-Downloads-C-NEW-DA.xlsm
0
 
LUIS FREUNDAuthor Commented:
Awesome!
0
 
LUIS FREUNDAuthor Commented:
Thank you so much....works great!
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Luis!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now