VBA for Vlookup in another workbook and replace data

[excel01noob]

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

id	sales	Customer ID
chair	1000	1008000
table	1000	1045070
wardrobe	15000	12345
chair	34000	123
table	43000	654321
wardrobe	12000	1051
chair	450003	7071

-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 ID	country	Acc ref
108	PRT	PT10081990
145	LUX	X10082004
294	ESP	S10082017
389	FRA	F10082017
589	GER	G10092016
988	UK	UK10091975
230	SLO	SO10092000

How to set up this in VBA?

 

[Zot]

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.

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

 

[excel01noob]

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!

Id	sales	Customer ID
chair	1,000.00	108000​	x
table	1,000.00	1450700​	x
wardrobe	15,000.00	12345​
chair	34,000.00	123​
table	43,000.00	654321​
wardrobe	12,000.00	98856467​	x
chair	450,003.00	9870​
chair	450,003.00	988​	x

 

[Zot]

Thanks for update

 

[excel01noob]

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]

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

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]

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)

 

[Zot]

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.

 

[excel01noob]

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")

Id	sales	Customer ID
chair	1,000.00	108000​
table	1,000.00	1450700​
wardrobe	15,000.00	12345​
chair	34,000.00	123​
table	43,000.00	654321​
wardrobe	12,000.00	98856467​
chair	450,003.00	9870​
chair	450,003.00	988​
table	43,000.00	6108567​

Template.xlsm (saved on 2nd Sheet "Sheet2")

Customer ID	country	Acc ref
108	PRT	PT10081990
145	LUX	X10082004
294	ESP	S10082017
389	FRA	F10082017
589	GER	G10092016
988	UK	UK10091975
230	SLO	SO10092000

 

[Zot]

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
	A	B	C	D	E	F	G	H
1
2							108000
3							1450700
4							98856467
5							988
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
	A	B	C	D	E	F	G	H
1
2							108000
3							1450700
4							98856467
5							988
6
FinalData

Here's the code used:

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