asked on

Excel

Hello, I am having trouble with excel, I'm still new, but I was wondering if you have two Excel files, say File A and B. If File A has a list such as

and File B is another list with updates or new additions:

If I want to update File A with the changes that correspond to the Code Number, or add in new Code Numbers if there are any new items. In the image above, B has some changes for Code 1, 3 and a new code, 4. There are some changes if compared with File A, so File A will need to update its cells for Code 1, 3, and add a new code, 4.

It should look like this for File A:

How would I do that for excel with code numbers that are in the tens of thousands?

I found an add-in that has what I need, but I need to pay for it: https://www.ablebits.com/excel-lookup-tables/

SOLUTION

Shaun Vermaak

membership

This solution is only available to members.

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

Start Free Trial

Shums Faruk

Hi Bob,

Please find attached...Please download both the file in one folder.

And from File A, press press Update from B, when Explorer opens and ask to select file, select FileBB.

It will update FileAA and close FileBB.

Hope this helps.
FileAA.xlsm
FileBB.xlsx

Shums Faruk

Here is the code for other's reference:

Private Sub UpdateFile_Click()
Dim FolderPath As String
Dim WizBook As Workbook
Dim Filter As String
Dim Caption As String
Dim WizFileName As String
Dim WizWorkbook As Workbook
Dim TargetWorkbook As Workbook
Dim targetSheet As Worksheet
Dim LastRow1 As Long, LastRow2 As Long

With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

FolderPath = Application.ThisWorkbook.Path
ChDir FolderPath
    
' make weak assumption that active workbook is the target
Set TargetWorkbook = Application.ThisWorkbook
         
' get the wiz workbook
Filter = "Text files (*.xl*),*.xl*"
Caption = "Please Select an input file "
    
WizFileName = Application.GetOpenFilename(Filter, , Caption)
    
Set WizWorkbook = Application.Workbooks.Open(WizFileName)

' copy data to target workbook
Set targetSheet = TargetWorkbook.Worksheets("Sheet1")
LastRow1 = targetSheet.Range("A" & Rows.Count).End(xlUp).Row
        
' copy data from wiz workbook
Dim sourceSheet As Worksheet
Set sourceSheet = WizWorkbook.Sheets(1) 'Change the Sheet Name, from where you want to copy Data
sourceSheet.Activate
LastRow2 = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row 'Change the last row as needed
        
sourceSheet.Range("A2:D" & LastRow2).Copy 'Change the range you need to copy
targetSheet.Range("A" & LastRow1 + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete Duplicates
Dim LR_Dup As Long
LR_Dup = targetSheet.Range("A" & Rows.Count).End(xlUp).Row
Dim MatchFoundIndex As Long
Dim iCntr As Long
For iCntr = 1 To LR_Dup
    If Cells(iCntr, 1) <> "" Then
        MatchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & LR_Dup), 0)
        If iCntr <> MatchFoundIndex Then
            Cells(iCntr, 1).EntireRow.Delete
            iCntr = iCntr - 1
        End If
    End If
Next iCntr

targetSheet.Activate
targetSheet.Range("A1").Select
    
' Close wiz workbook
Application.DisplayAlerts = False
WizWorkbook.Close savechanges:=False
Application.DisplayAlerts = True

Call SortData

With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Sub SortData()
Dim Ws As Worksheet
Dim LR As Long
Set Ws = Worksheets("Sheet1")
LR = Ws.Range("A" & Rows.Count).End(xlUp).Row

Ws.Sort.SortFields.Clear
    Ws.Sort.SortFields.Add Key:=Range("A2:A" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With Ws.Sort
        .SetRange Range("A1:D" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Open in new window

Bob Tian

ASKER

Hey Shums,

I'm having trouble getting this to work for one of my files that range from A to AD48000, the list to be updated is called 'SuperList', and the file with the updated list is called 'PMMax'.

Shums Faruk

From which row your data is starting in A columns? in SuperList and PMMax?

Bob Tian

ASKER

SuperList and PMMax both start in Column A2 (where the first code starts at)
SuperList has A to AD48000, while PMMax has A to M17000

Shums Faruk

OK Sir, please replace your current code with below and let me know;

Private Sub UpdateFile_Click()
Dim FolderPath As String
Dim WizBook As Workbook
Dim Filter As String
Dim Caption As String
Dim WizFileName As String
Dim WizWorkbook As Workbook
Dim TargetWorkbook As Workbook
Dim targetSheet As Worksheet
Dim LastRow1 As Long, LastRow2 As Long

With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

FolderPath = Application.ThisWorkbook.Path
ChDir FolderPath
    
' make weak assumption that active workbook is the target
Set TargetWorkbook = Application.ThisWorkbook
         
' get the wiz workbook
Filter = "Text files (*.xl*),*.xl*"
Caption = "Please Select an input file "
    
WizFileName = Application.GetOpenFilename(Filter, , Caption)
    
Set WizWorkbook = Application.Workbooks.Open(WizFileName)

' copy data to target workbook
Set targetSheet = TargetWorkbook.Worksheets("SuperList")
LastRow1 = targetSheet.Range("A" & Rows.Count).End(xlUp).Row
        
' copy data from wiz workbook
Dim sourceSheet As Worksheet
Set sourceSheet = WizWorkbook.Worksheets("PMMax") 'Change the Sheet Name, from where you want to copy Data
sourceSheet.Activate
LastRow2 = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row 'Change the last row as needed
        
sourceSheet.Range("A2:D" & LastRow2).Copy 'Change the range you need to copy
targetSheet.Range("A" & LastRow1 + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete Duplicates
Dim LR_Dup As Long
LR_Dup = targetSheet.Range("A" & Rows.Count).End(xlUp).Row
Dim MatchFoundIndex As Long
Dim iCntr As Long
For iCntr = 1 To LR_Dup
    If Cells(iCntr, 1) <> "" Then
        MatchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & LR_Dup), 0)
        If iCntr <> MatchFoundIndex Then
            Cells(iCntr, 1).EntireRow.Delete
            iCntr = iCntr - 1
        End If
    End If
Next iCntr

targetSheet.Activate
targetSheet.Range("A1").Select
    
' Close wiz workbook
Application.DisplayAlerts = False
WizWorkbook.Close savechanges:=False
Application.DisplayAlerts = True

Call SortData

With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Sub SortData()
Dim Ws As Worksheet
Dim LR As Long
Set Ws = Worksheets("Sheet1")
LR = Ws.Range("A" & Rows.Count).End(xlUp).Row

Ws.Sort.SortFields.Clear
    Ws.Sort.SortFields.Add Key:=Range("A2:A" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With Ws.Sort
        .SetRange Range("A1:D" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Open in new window

Bob Tian

ASKER

Im getting a runtime error 1004:
Method 'Range' of object '_Worksheet' failed

on this line according to debug:
LastRow2 = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row 'Change the last row as needed

Shums Faruk

Press Ctrl + End in both the file and tell me the cell number.

Bob Tian

ASKER

For superlist: AB49875
for PMMax: L16598

Shums Faruk

Do you need those data of AB & L Columns? You mentioned you just need data of 4 columns A,B,C & D.

Bob Tian

ASKER

The actual data in SuperList that needs to be updated is in column G and H
The data in PMMax that has the updated values is in column B and C

Shums Faruk

Whoops. Its all different Columns.

So you mean you need Data of B & C from PMMax to G & H in SuperList?

Bob Tian

ASKER

Yes, apologies for the confusion. If there are any updates from PMMax's B and C, it should change in SuperList's G and H, otherwise if the values did not change, then there should be no changes.

Shums Faruk

OK Sir, please replace your current code with below and let me know;

Private Sub UpdateFile_Click()
Dim FolderPath As String
Dim WizBook As Workbook
Dim Filter As String
Dim Caption As String
Dim WizFileName As String
Dim WizWorkbook As Workbook
Dim TargetWorkbook As Workbook
Dim targetSheet As Worksheet
Dim LastRow1 As Long, LastRow2 As Long

With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

FolderPath = Application.ThisWorkbook.Path
ChDir FolderPath
    
' make weak assumption that active workbook is the target
Set TargetWorkbook = Application.ThisWorkbook
         
' get the wiz workbook
Filter = "Text files (*.xl*),*.xl*"
Caption = "Please Select an input file "
    
WizFileName = Application.GetOpenFilename(Filter, , Caption)
    
Set WizWorkbook = Application.Workbooks.Open(WizFileName)

' copy data to target workbook
Set targetSheet = TargetWorkbook.Worksheets("SuperList")
LastRow1 = targetSheet.Range("AB" & Rows.Count).End(xlUp).Row
        
' copy data from wiz workbook
Dim sourceSheet As Worksheet
Set sourceSheet = WizWorkbook.Worksheets("PMMax") 'Change the Sheet Name, from where you want to copy Data
sourceSheet.Activate
LastRow2 = sourceSheet.Range("L" & Rows.Count).End(xlUp).Row 'Change the last row as needed
        
sourceSheet.Range("B2:C" & LastRow2).Copy 'Change the range you need to copy
targetSheet.Range("G" & LastRow1 + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete Duplicates
Dim LR_Dup As Long
LR_Dup = targetSheet.Range("AB" & Rows.Count).End(xlUp).Row
Dim MatchFoundIndex As Long
Dim iCntr As Long
For iCntr = 1 To LR_Dup
    If Cells(iCntr, 1) <> "" Then
        MatchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("G1:G" & LR_Dup), 0)
        If iCntr <> MatchFoundIndex Then
            Cells(iCntr, 1).EntireRow.Delete
            iCntr = iCntr - 1
        End If
    End If
Next iCntr

targetSheet.Activate
targetSheet.Range("A1").Select
    
' Close wiz workbook
Application.DisplayAlerts = False
WizWorkbook.Close savechanges:=False
Application.DisplayAlerts = True

Call SortData

With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Sub SortData()
Dim Ws As Worksheet
Dim LR As Long
Set Ws = Worksheets("SuperList")
LR = Ws.Range("AB" & Rows.Count).End(xlUp).Row

Ws.Sort.SortFields.Clear
    Ws.Sort.SortFields.Add Key:=Range("G2:G" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With Ws.Sort
        .SetRange Range("A1:AB" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Open in new window

Bob Tian

ASKER

Im getting another run-time error: 1004
Unable to get the Match property of the WorksheetFunction class

Line: MatchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("G1:G" & LR_Dup), 0)

ASKER CERTIFIED SOLUTION

Shums Faruk

membership

This solution is only available to members.

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

Start Free Trial