vba search and return all matching results from one single column

[BoyBoy]

Hello,
I am looking for a script which can lookup and return all the value (all duplicates) in one column from multiple criteria.
My sheet 1 will look up the value in column E from sheet 2 the master table and return value (if exist) in column F, G & H.
I've only listed 8 storages in my example, but the total storage number could be up to 500, and the same apply to the master table in sheet 2.

Vehicle Model Inventory.xlsx
	A	B	C	D	E	F	G	H
1	Storage				Vehicle Model	Serial No 1	Serial No 2	Serial No 3
2	A				No 9
3	B				No 9
4	C				No 9
5	D				No 9
6	E				No 9
7	F				No 9
8	G				No 9
9	H				No 9
Sheet1

Vehicle Model Inventory.xlsx
	A	B	C
1	Storage	Vehicle Model	Serial No
2	A	No 9	SX-123
3	A	No 9	SX-263
4	A	No 4	SX-123
5	B	No 15	SX-263
6	B	No 9	SX-123
7	B	No 9	SX-263
8	B	No 2	SX-123
9	C	No 2	SX-263
10	C	No 2	SX-123
11	C	No 9	SX-123
12	C	No 4	SX-123
13	D	No 15	SX-123
14	D	No 15	SX-263
15	D	No 2	SX-123
16	D	No 2	SX-578
17	E	No 4	SX-123
18	E	No 9	SX-123
19	E	No 4	SX-263
20	F	No 9	SX-263
21	F	No 15	SX-123
22	F	No 4	SX-123
23	G	No 9	SX-123
24	G	No 9	SX-263
25	G	No 9	SX-578
26	H	No 2	SX-123
27	H	No 2	SX-263
28	H	No 2	SX-578
Sheet2

A simple working vba code would be greatly appreciated.

BoyBoy

 

[Fluff]

How about

Sub BoyBoy()
   Dim Ary As Variant
   Dim r As Long
   Dim Dic As Object
   Dim Cl As Range
   
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   For r = 2 To UBound(Ary)
      If Not Dic.Exists(Ary(r, 1)) Then Dic.Add Ary(r, 1), CreateObject("scripting.dictionary")
      Dic(Ary(r, 1))(Ary(r, 2)) = Dic(Ary(r, 1))(Ary(r, 2)) & Ary(r, 3) & "|"
   Next r
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 5).Value = Dic(Cl.Value)(Cl.Offset(, 4).Value)
      Next Cl
      .Range("F2", .Range("F" & Rows.Count).End(xlUp)).TextToColumns .Range("F2"), xlDelimited, , , 0, 0, 0, 0, 1, "|"
   End With
End Sub

 

[BoyBoy]

How about

Sub BoyBoy()
   Dim Ary As Variant
   Dim r As Long
   Dim Dic As Object
   Dim Cl As Range
  
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   For r = 2 To UBound(Ary)
      If Not Dic.Exists(Ary(r, 1)) Then Dic.Add Ary(r, 1), CreateObject("scripting.dictionary")
      Dic(Ary(r, 1))(Ary(r, 2)) = Dic(Ary(r, 1))(Ary(r, 2)) & Ary(r, 3) & "|"
   Next r
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 5).Value = Dic(Cl.Value)(Cl.Offset(, 4).Value)
      Next Cl
      .Range("F2", .Range("F" & Rows.Count).End(xlUp)).TextToColumns .Range("F2"), xlDelimited, , , 0, 0, 0, 0, 1, "|"
   End With
End Sub

Thank you so much, this works like a charm in the example I've provided, however, I've got this error

when I tried it on a different scenario, like expanded the # of the storage in sheet1, but not all of the storages in sheet1 are listed in the master sheet (sheet2)

Vehicle Model Inventory.xlsm
	A	B	C	D	E	F	G	H
1	Storage				Vehicle Model
2	A				No 9
3	B				No 9
4	C				No 9
5	D				No 9
6	E				No 9
7	F				No 9
8	G				No 9
9	H				No 9
10	J				No 9
11	K				No 9
12	L				No 9
13	M				No 9
14	N				No 9
15	O				No 9
16	P				No 9
17	Q				No 9
18	R				No 9
19	S				No 9
20	T				No 9
21	U				No 9
22	V				No 9
23	W				No 9
24	X				No 9
25	Y				No 9
26	Z				No 9
Sheet1

Vehicle Model Inventory.xlsm
	A	B	C
1	Storage	Vehicle Model	Serial No
2	K	No 15	SX-123
3	L	No 15	SX-263
4	M	No 4	SX-123
5	O	No 9	SX-263
6	O	No 9	SX-123
7	B	No 15	SX-263
8	B	No 2	SX-123
9	Z	No 2	SX-263
10	Z	No 2	SX-123
11	Z	No 15	SX-123
12	Z	No 4	SX-123
13	T	No 9	SX-123
14	T	No 9	SX-263
15	Q	No 2	SX-123
16	Q	No 2	SX-578
17	E	No 4	SX-123
18	E	No 15	SX-123
19	E	No 4	SX-263
20	F	No 9	SX-263
21	F	No 15	SX-123
22	F	No 4	SX-123
23	G	No 15	SX-123
24	G	No 9	SX-263
25	G	No 9	SX-578
26	H	No 2	SX-123
27	H	No 2	SX-263
28	H	No 2	SX-578
29	I	No 9	SX-578
30	I	No 2	SX-123
31	I	No 2	SX-263
32	I	No 2	SX-578
33	J	No 9	SX-578
34	K	No 2	SX-123
35	K	No 2	SX-263
36	K	No 2	SX-578
Sheet2

Any ideas how I can modify the code?
Thank you.
BoyBoy

 

[Fluff]

How about

Sub BoyBoy()
   Dim Ary As Variant
   Dim r As Long
   Dim Dic As Object
   Dim Cl As Range
   
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   For r = 2 To UBound(Ary)
      If Not Dic.Exists(Ary(r, 1)) Then Dic.Add Ary(r, 1), CreateObject("scripting.dictionary")
      Dic(Ary(r, 1))(Ary(r, 2)) = Dic(Ary(r, 1))(Ary(r, 2)) & Ary(r, 3) & "|"
   Next r
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Cl.Offset(, 5).Value = Dic(Cl.Value)(Cl.Offset(, 4).Value)
      Next Cl
      .Range("F2", .Range("F" & Rows.Count).End(xlUp)).TextToColumns .Range("F2"), xlDelimited, , , 0, 0, 0, 0, 1, "|"
   End With
End Sub

 

[BoyBoy]

How about

Sub BoyBoy()
   Dim Ary As Variant
   Dim r As Long
   Dim Dic As Object
   Dim Cl As Range
  
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   For r = 2 To UBound(Ary)
      If Not Dic.Exists(Ary(r, 1)) Then Dic.Add Ary(r, 1), CreateObject("scripting.dictionary")
      Dic(Ary(r, 1))(Ary(r, 2)) = Dic(Ary(r, 1))(Ary(r, 2)) & Ary(r, 3) & "|"
   Next r
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Cl.Offset(, 5).Value = Dic(Cl.Value)(Cl.Offset(, 4).Value)
      Next Cl
      .Range("F2", .Range("F" & Rows.Count).End(xlUp)).TextToColumns .Range("F2"), xlDelimited, , , 0, 0, 0, 0, 1, "|"
   End With
End Sub

This works great! The result is just the way I wanted, thank you very much for your help!
Have a wonderful day.
BoyBoy

 

[Fluff]

You're welcome & thanks for the feedback.