Return multiple matches for lookup

KGee

Well-known Member
Joined
Nov 26, 2008
Messages
537
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have two separate Excel files that have a common ID between them. File one is considered the master and each ID appears one time only. The second file includes the same ID's and also includes a list of staff names. In the cell next to the ID in file one, I want to list all of the names from file two that have a match for the ID. Below is an example of what I am trying to achieve. Is it possible to use a vlookup to return multiple values or can a script be written that would loop through the files to compile the names? Also, the names don't have to appended in the same cell, they can be listed in adjacent cells as long as they are in the same row as the ID.

FILE 1 (ID)
ABC1000
ABC1001
ABC1002
FILE 2 (NAME)(ID)
Name 1ABC1000
Name 1ABC1001
Name 2ABC1000
Name 3ABC1000
Name 4ABC1001
Name 4ABC1002
DESIRED RESULT
FILE 1 (ID)(NAME)
ABC1000Name 1, Name 2, Name 3
ABC1001Name 1, Name 4
ABC1002Name 4

<tbody>
</tbody>
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Try:
This is an array formula and must be entered with CTRL-SHIFT-ENTER.
Drag formula across and down.
Excel Workbook
ABCD
1NAME(ID)
2Name 1ABC1000
3Name 1ABC1001
4Name 2ABC1000
5Name 3ABC1000
6Name 4ABC1001
7Name 4ABC1002
8
9
10
11IDName
12ABC1000Name 1Name 2Name 3
13ABC1001Name 1Name 4
14ABC1002Name 4
Sheet
 
Upvote 0
Untested, but try
Code:
Sub GetNames()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   
   Set Ws1 = [COLOR=#ff0000]Workbooks("book1.xlsm").Sheets(1)[/COLOR]
   Set Ws2 = [COLOR=#ff0000]Workbooks("book2.xlsm").Sheets(1)[/COLOR]
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Ws2.Range("B2", Ws2.Range("B" & Rows.Count).End(xlUp))
      If Not Dic.exists(Cl.Value) Then
         Dic.Add Cl.Value, Cl.Offset(, -1).Value
      Else
         Dic(Cl.Value) = Dic(Cl.Value) & ", " & Cl.Offset(, -1).Value
      End If
   Next Cl
   For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
      If Dic.exists(Cl.Value) Then Cl.Offset(, 1).Value = Dic(Cl.Value)
   Next Cl

End Sub
Change workbook/worksheet names to suit.
Both workbooks need to be open when you run this.
 
Upvote 0
I tried the first option and that worked. Thanks Ahoy
 
Upvote 0

Forum statistics

Threads
1,215,030
Messages
6,122,762
Members
449,095
Latest member
m_smith_solihull

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
Back
Top