VBA for Vlookup in another workbook and replace data

excel01noob

Board Regular
Joined
Aug 5, 2019
Messages
87
Office Version
  1. 365
  2. 2016
I need to combine the customer ID from one report received (table 1) with a table where I need to find the respective Account reference (table 2).
Issues I have:

-Customer ID is formatted as "number" in table 1. If that ID is => to 6 characters I need to take the first 3 digits from the customer ID (from the left);

Table 1
idsalesCustomer ID
chair10001008000
table10001045070
wardrobe1500012345
chair34000123
table43000654321
wardrobe120001051
chair4500037071

-with those 3 digits, I need to search in the customer ID on table 2 (which is not formatted as number but as text). When that is matched, I need to take the Acc ref

-then paste it in another sheet Column G (I add this sheet named "Final data" in the same file from where I am getting the table 1 raw data.

Table 2

Customer IDcountryAcc ref
108PRTPT10081990
145LUXX10082004
294ESPS10082017
389FRAF10082017
589GERG10092016
988UKUK10091975
230SLOSO10092000

How to set up this in VBA?
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,883
Office Version
  1. 2016
Platform
  1. Windows
I'm not sure if I understood it right but there is no matching on Table 2 in example provided. Is that correct? I wonder if you would face problem with Customer ID 12345 and 123 in example above.

VBA Code:
Sub Search_ID_and_Copy_Acc()

Dim Fname As Variant
Dim IDNo As String
Dim cell As Range, rngID As Range, rngFound As Range
Dim ws1 As Worksheet, ws2 As Worksheet, wsFinalData As Worksheet
Dim wbSource As Workbook, wbData As Workbook

Application.ScreenUpdating = False

' Define this Workbook as wbSource
Set wbSource = ActiveWorkbook
' Define working sheet in wbSource. Change sheet name accordingly
Set ws1 = wbSource.Sheets("Sheet1")
Set wsFinalData = wbSource.Sheets("Final Data")

' Select Workbook Data
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub                         'CANCEL is clicked

' Define opened Workbook as wbData while opening it.
Set wbData = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
' Define working sheet in wbData. Change sheet name accordingly
Set ws2 = wbData.Sheets("Sheet1")

' Define Account Reference data range
Set rngID = ws2.Range("A2", ws2.Cells(Rows.Count, "A").End(xlUp))

' Search for matching ID in rngID and copy Accout Ref starting from row 2
For Each cell In ws1.Range("C2", ws1.Cells(Rows.Count, "C").End(xlUp))
    IDNo = Left(CStr(cell), 3)
    Set rngFound = rngID.Find(IDNo)
    If Not rngFound Is Nothing Then
        ws2.Range("C" & rngFound.Row).Copy wsFinalData.Range("G" & wsFinalData.Cells(Rows.Count, "G").End(xlUp).Row + 1)
    End If
Next

End Sub
 
Solution

excel01noob

Board Regular
Joined
Aug 5, 2019
Messages
87
Office Version
  1. 365
  2. 2016
Hi Zot

Indeed, my Table 1 had incorrect data, you should not get any result.....
I have modified and used the code you provided, the 4 results with an "x" are correct, it worked perfectly, much appreciated!

IdsalesCustomer ID
chair1,000.00
108000​
x
table1,000.00
1450700​
x
wardrobe15,000.00
12345​
chair34,000.00
123​
table43,000.00
654321​
wardrobe12,000.00
98856467​
x
chair450,003.00
9870​
chair450,003.00
988​
x
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,883
Office Version
  1. 2016
Platform
  1. Windows
Thanks for update
 

excel01noob

Board Regular
Joined
Aug 5, 2019
Messages
87
Office Version
  1. 365
  2. 2016

ADVERTISEMENT

the amended table in my post#3 should actually only show 3 results as per the criteria defined as the "Customer ID table 1" must have 6 or more characters in order to check against table 2. As it has only 3 characters, that line is outside the criteria

Would it be possible to change the code to run assuming that both workbooks are already opened?

I am using
wbTemplate = where I have macro button, Table 2 is on the 2nd sheet, this workbook should not be changed
wbRawdata = Table 1 is on the sheet Rawdata, Final data is on this workbook where I want to paste the Account ID from table 2
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,883
Office Version
  1. 2016
Platform
  1. Windows
Check the modified code as you require the other book opened. The code now looping the Customer ID in RawData every time going down the Template list to find match and write whole Customer ID. Now no more stating 3 digit from left in RawData Customer ID but just matching the digit in Template.

Important to note that if using Instr the Template 123 will match if Customer ID is 45123654. Perhaps you need to consider sticking to Left. You can easily modify the code :)

VBA Code:
Sub Search_ID_and_Copy_Acc()

Dim Fname As Variant
Dim IDNo As String
Dim cell As Range, CustID As Range, rngID As Range, rngFound As Range
Dim wsTemplate As Worksheet, wsRawData As Worksheet, wsFinalData As Worksheet
Dim wbTemplate As Workbook, wbRawData As Workbook

Application.ScreenUpdating = False

' Define this Workbook as wbTemplate
Set wbTemplate = ActiveWorkbook
' Define working sheet in wbTemplate. Change sheet name accordingly
Set wsTemplate = wbTemplate.Sheets("Sheet2")

' Define opened Workbook as wbRawData
Set wbRawData = Workbooks("wbRawData.xlsx")
' Define working sheet in wbRawData. Change sheet name accordingly
Set wsRawData = wbRawData.Sheets("RawData")
Set wsFinalData = wbRawData.Sheets("FinalData")

' Define Customer ID range in RawData
Set rngID = wsRawData.Range("C2", wsRawData.Cells(Rows.Count, "C").End(xlUp))

' Go through Template list and find match in RawData by looping
For Each cell In wsTemplate.Range("A2", wsTemplate.Cells(Rows.Count, "A").End(xlUp))
    For Each CustID In rngID
        If InStr(CustID, cell) > 0 Then
            wsFinalData.Range("G" & wsFinalData.Cells(Rows.Count, "G").End(xlUp).Row + 1) = CustID
        End If
    Next
Next

End Sub
 

excel01noob

Board Regular
Joined
Aug 5, 2019
Messages
87
Office Version
  1. 365
  2. 2016

ADVERTISEMENT

yes, I need to stick to the left of each Customer ID Table 1 but aren't you missing to check the Lenght of each of those cells?
I could not understand what you are referring as CustID

with the updated code I get 2 results when I should have gotten 3 (line 1,2,6)
 
Last edited:

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,883
Office Version
  1. 2016
Platform
  1. Windows
yes, I need to stick to the left of each Customer ID Table 1 but aren't you missing to check the Lenght of each of those cells?
I could not understand what you are referring as CustID

with the updated code I get 2 results when I should have gotten 3 (line 1,2,6)
When I run it, I get the same result like you marked x.

CustID is just the same as cell range variable I used to loop the row. The cell is used to loop ID in wsTemplate. The CustID is used as variable to loop the ID in RawData (or rngID).

The For each cell take ID from Table 2 starting with 108. Then the program will loop ID in Table 1 looking for any 108 sequence using InStr in Table 1. It will match 108000 in your modified Table 1. The advantage of using InStr would be that the matching is true if the Customer ID is say 6108567.

So, you can change
If InStr(CustID, cell) > 0 Then

to become
If Left(CStr(CustID), 3) = cell Then

This will look for 3 character from the left.

Hope this will clarify.
 
Last edited:

excel01noob

Board Regular
Joined
Aug 5, 2019
Messages
87
Office Version
  1. 365
  2. 2016
Strange

I cannot get any result using If Left(CStr(CustID), 3) = cell Then

And using If InStr(CustID, cell) > 0 Then I get more results than what I wanted.

After this
' Define Customer ID range in RawData
...
shouldn't a If statement be in place ("if the Customer ID cell "rawdata" has 6 or more characters then take from the left the first 3 digits and compare with the customer ID "template". If the 3 digits match with customer ID "template", then take the Acc ref "template" cell and paste in the FinalData sheet).
If no match with customer ID "template" or Customer ID "rawdata has less than 6 characters, do nothing.
if below, do nothing and move to next cell")?

As you mentioned the issue with a Customer ID 6108567 I included this on my rawdata table.
This would not be a result as per my criteria (it's have more than 6 characters but the first 3 digits do not match any of the Customer ID "template")


The tables look like this now

wbRawData.xlsx (1st Tab "Rawdata" and 2nd sheet "FinalData")
IdsalesCustomer ID
chair1,000.00
108000​
table1,000.00
1450700​
wardrobe15,000.00
12345​
chair34,000.00
123​
table43,000.00
654321​
wardrobe12,000.00
98856467​
chair450,003.00
9870​
chair450,003.00
988​
table43,000.00
6108567​


Template.xlsm (saved on 2nd Sheet "Sheet2")
Customer IDcountryAcc ref
108PRTPT10081990
145LUXX10082004
294ESPS10082017
389FRAF10082017
589GERG10092016
988UKUK10091975
230SLOSO10092000
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,883
Office Version
  1. 2016
Platform
  1. Windows
You are right, I should have looped the ID on the RawData sheet. My first code was actually putting the result on the macro workbook but then changed to wbRawData. I thought that caused the confusion. However, when I ran the code, unlike you, I get this result
wbRawData.xlsx
ABCDEFGH
1
2108000
31450700
498856467
5988
6
FinalData


Maybe something to do with number compare to string. Try to intall and use XL2BB tool to copy sheet. If you copy like you did in your reply, whenever I copy the sheet, the number in the cell is not actually what is actually stored. If run the macro step by step [F8], instead of 108000, the value during run is 108000?. This gave me unexpected result. Maybe that's why the CStr as there to convert to string.

Not sure why you have no result. However, I've change to loop the raw data side and some tidying in code. This is my result now with the data sample you provided. Still the same.
wbRawData.xlsx
ABCDEFGH
1
2108000
31450700
498856467
5988
6
FinalData


Here's the code used:
VBA Code:
Sub Search_ID_and_Copy_Acc()

Dim Fname As Variant
Dim IDNo As String, xCustID As String
Dim cell As Range, IDcell As Range, rngID As Range, rngTemplate As Range
Dim wsTemplate As Worksheet, wsRawData As Worksheet, wsFinalData As Worksheet
Dim wbTemplate As Workbook, wbRawData As Workbook

Application.ScreenUpdating = False

' Define this Workbook as wbTemplate
Set wbTemplate = ActiveWorkbook
' Define working sheet in wbTemplate. Change sheet name accordingly
Set wsTemplate = wbTemplate.Sheets("Sheet2")

' Define opened Workbook as wbRawData
Set wbRawData = Workbooks("wbRawData.xlsx")
' Define working sheet in wbRawData. Change sheet name accordingly
Set wsRawData = wbRawData.Sheets("RawData")
Set wsFinalData = wbRawData.Sheets("FinalData")

' Define Customer ID range in RawData and Template ID
Set rngID = wsRawData.Range("C2", wsRawData.Cells(Rows.Count, "C").End(xlUp))
Set rngTemplate = wsTemplate.Range("A2", wsTemplate.Cells(Rows.Count, "A").End(xlUp))

' Go through Template list and find match in RawData by looping
For Each IDcell In rngID
    xCustID = Left(IDcell, 3)
    For Each cell In rngTemplate
        If xCustID = cell Then
            wsFinalData.Range("G" & wsFinalData.Cells(Rows.Count, "G").End(xlUp).Row + 1) = IDcell
        End If
    Next
Next

End Sub
 

Forum statistics

Threads
1,148,370
Messages
5,746,299
Members
424,006
Latest member
Metal_warrior

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top