VBA vlookup multiple results

[dappy]

Hi folks,

Hopefully someone out there can help.

I have a list to vlookup which works (ish). the lookup only picks up the first instance of the source and not all instances.

source	requested	output
table-500227table--500227/line-110/output_2	500227​	table-500227table--500227/line-110/output_2
table-500227table--500227/line-120/output_2	500163​	table-500163table--500163/line-110/output_2
table-500227table--500227/line-130/output_2	500165​	table-500165table--500165/line-110/output_2
table-500163table--500163/line-110/output_2
table-500163table--500163/line-120/output_2
table-500163table--500163/line-130/output_2
table-500165table--500165/line-110/output_2
table-500165table--500165/line-120/output_2

the code i have that doesnt work completely

Dim Rw As Long
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim WsF As Object
Set WsF = Application.WorksheetFunction


Set ws1 = ThisWorkbook.Sheets("dump")
Set ws2 = ThisWorkbook.Sheets("batch_list")
Set ws3 = ThisWorkbook.Sheets("output")

For Rw = 1 To 1000
On Error Resume Next
ws3.Cells(Rw, "A") = WsF.VLookup(ws2.Cells(Rw, "A"), ws1.Range("A1:b30000"), 2, False)
Next Rw

For Rw = 1 To 27
On Error Resume Next
ws3.Cells(Rw, "c") = WsF.VLookup(ws2.Cells(Rw, "A"), ws1.Range("d1:e30000"), 2, False)
Next Rw

any help or guidance much appreciated as normal
thanks in advance

 

[mohadin]

Hi
May you try this code

Sub test()
    Dim a As Variant, i, x
    Dim ws1, ws2, ws3 As Worksheet
    Set ws1 = ThisWorkbook.Sheets("dump")
    Set ws2 = ThisWorkbook.Sheets("batch_list")
    Set ws3 = ThisWorkbook.Sheets("output")
    a = ws1.Range("a1:a" & ws1.Cells(Rows.Count, 1).End(xlUp).Row)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            x = Split(Split(a(i, 1), "--")(1), "/")(0)
            If a(i, 1) <> 0 Then
                If Not .exists(x) Then
                    .Add x, a(i, 1)
                End If
            End If
        Next
        a = ws2.Range("a1:a" & ws2.Cells(Rows.Count, 1).End(xlUp).Row).Value
        For i = 0 To .Count - 1
            x = CStr(a(i + 1, 1))
            If .exists(CStr(a(i + 1, 1))) Then
                ws3.Cells(i + 1, 1) = .items()(i)
            End If
        Next
    End With
End Sub

PS: Every thing start from row1

 

[CsJHUN]

Oh its even easier (if i not make any more mistake :D), the batchlist values are handwriten, right? :D

Sub Dappy_mrexcel()
'https://www.mrexcel.com/board/threads/vba-vlookup-multiple-results.1149524/
Dim request_cell As Variant
Dim search_cell As Variant
Set ws1 = ThisWorkbook.Sheets("dump")
Set ws2 = ThisWorkbook.Sheets("batchlist")
Set ws3 = ThisWorkbook.Sheets("output")

request_rows = ws2.Range("a" & Rows.Count).End(3).Row
search_rows = ws1.Range("A" & Rows.Count).End(3).Row
b = 1
Do
b = b + 1
    req_id = ws2.Range("A" & b).Value
    For A = 2 To search_rows
        search_id = ws1.Range("A" & A).Value
        On Error Resume Next
        str_find = InStr(1, search_id, req_id) > 0
        If str_find Then
        i = i + 1
            ws3.Range("A" & i).Value = search_id
        End If
    Next A
 
Loop Until b >= request_rows
End Sub

 

[dappy]

that's mostly there! it shows just the 6 digit number and i need the whole cell value. is that possible?

 

[mohadin]

Wich code you are referring?

 

[dappy]

Apologies, i wasnt clear.

from post 12

Instead of getting this

output

table-500227table--500227/line-110/output_2

table-500227table--500227/line-120/output_2

table-500227table--500227/line-130/output_2

table-500163table--500163/line-110/output_2

table-500163table--500163/line-120/output_2

table-500163table--500163/line-130/output_2

table-501322table--501322/line-110/output_2

table-501322table--501322/line-120/output_2

table-501322table--501322/line-130/output_2

table-501322table--501322/line-140/output_2

I get this

output

500227​

500227​

500227​

500163​

500163​

500163​

501322​

501322​

501322​

501322​

 

[mohadin]

Well
in my code
dump data in column A2 down
batch_list data in column A2 down
Result in sheet output A2 down

Sub test()
    Dim a As Variant, i, x, l
    Dim ws1, ws2, ws3 As Worksheet
    Set ws1 = ThisWorkbook.Sheets("dump")
    Set ws2 = ThisWorkbook.Sheets("batch_list")
    Set ws3 = ThisWorkbook.Sheets("output")
    a = ws1.Range("a2:a" & ws1.Cells(Rows.Count, 1).End(xlUp).Row)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            x = Split(Split(a(i, 1), "--")(1), "/")(0)
            If a(i, 1) <> 0 Then
                If Not .exists(x) Then
                    .Add x, a(i, 1)
                    Else
                  .Item(x) = .Item(x) & Chr(2) & a(i, 1)
                End If
            End If
        Next
        a = ws2.Range("a2:a" & ws2.Cells(Rows.Count, 1).End(xlUp).Row).Value
        For i = 0 To .Count - 1
            x = CStr(a(i + 1, 1))
            If .exists(CStr(a(i + 1, 1))) Then
            x = Split(.items()(i), Chr(2))
                ws3.Cells(l + i + 2, 1).Resize(UBound(x) + 1) = (x)
                l = l + UBound(x)
            End If
        Next
    End With
End Sub

 

[CsJHUN]

I dunno
Dump:

Munkafüzet1
	A
1	table-500227table--500227/line-110/output_2
2	table-500227table--500227/line-120/output_2
3	table-500227table--500227/line-130/output_2
4	table-500163table--500163/line-110/output_2
5	table-500163table--500163/line-120/output_2
6	table-500163table--500163/line-130/output_2
7	table-501322table--501322/line-110/output_2
8	table-501322table--501322/line-120/output_2
9	table-501322table--501322/line-130/output_2
10	table-501322table--501322/line-140/output_2
dump

batchlist:

Munkafüzet1
	A
1	501322
2	500163
3	500227
batchlist

Output:

Munkafüzet1
	A
1	table-501322table--501322/line-110/output_2
2	table-501322table--501322/line-120/output_2
3	table-501322table--501322/line-130/output_2
4	table-501322table--501322/line-140/output_2
5	table-500163table--500163/line-110/output_2
6	table-500163table--500163/line-120/output_2
7	table-500163table--500163/line-130/output_2
8	table-500227table--500227/line-120/output_2
9	table-500227table--500227/line-130/output_2
output

with code:

Sub Dappy_mrexcel()
'https://www.mrexcel.com/board/threads/vba-vlookup-multiple-results.1149524/
Dim request_cell As Variant
Dim search_cell As Variant
Set ws1 = ThisWorkbook.Sheets("dump")
Set ws2 = ThisWorkbook.Sheets("batchlist")
Set ws3 = ThisWorkbook.Sheets("output")

request_rows = ws2.Range("a" & Rows.Count).End(3).Row
search_rows = ws1.Range("A" & Rows.Count).End(3).Row
Do
b = b + 1
    req_id = ws2.Range("A" & b).Value
    For A = 1 To search_rows
        search_id = ws1.Range("A" & A).Value
        On Error Resume Next
        str_find = InStr(1, search_id, req_id) > 0
        If str_find Then
        i = i + 1
            ws3.Range("A" & i).Value = search_id
        End If
    Next A

Loop Until b >= request_rows
End Sub

 

[dappy]

AH CsJHun, my mistake, was being a plum. that works perfectly,

thank you so much for taking the time, very much appreciated

and thanks Mohadin for also taking time

 

[mohadin]

It Ok I tried to help
Thank you
Be happy

 

[dappy]

folks would it be cheeky of me to ask for further assistance?

the lookups i need are over a few columns, in in total. i've edited so i have 7 of the above code but its really slow to run. have i edited correctly? Here's the first 2 looking up columns B and E. is there anything i can do to make it all run faster? its looking up from 7000 rows.

request_rows = ws2.Range("a" & Rows.Count).End(3).Row
search_rows = ws1.Range("b" & Rows.Count).End(3).Row
i = 1
B = 1
Do
B = B + 1
req_id = ws2.Range("A" & B).Value
For a = 2 To search_rows
search_id = ws1.Range("B" & a).Value
On Error Resume Next
str_find = InStr(1, search_id, req_id) > 0
If str_find Then
i = i + 1
ws3.Range("B" & i).Value = search_id
End If
Next a
Loop Until B >= request_rows

request_rows = ws2.Range("a" & Rows.Count).End(3).Row
search_rows = ws1.Range("e" & Rows.Count).End(3).Row
i = 1
B = 1
Do
B = B + 1
req_id = ws2.Range("A" & B).Value
For a = 2 To search_rows
search_id = ws1.Range("e" & a).Value
On Error Resume Next
str_find = InStr(1, search_id, req_id) > 0
If str_find Then
i = i + 1
ws3.Range("e" & i).Value = search_id
End If
Next a
Loop Until B >= request_rows