Concatenation of multiple lookup matches

scory

Board Regular
Joined
Mar 7, 2005
Messages
53
As listed in other threads, the VLOOKUP function only returns the first occurence of a matching value from a range. I am looking for a solution which not only returns all matching values, but which concatenates them into a single cell on the worksheet.
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
This is a job for a macro. Hopefully you will be able to adapt this :-
Code:
Sub test()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim MyRange As Range
    Dim LookupTable As Range
    Dim LookupColumn As Range
    Dim ToCell As Range
    Dim MyFind As Variant
    Dim MyNewValue As Variant
    Dim FoundCell As Object
    Dim FoundRow As Long
    '------------------------------------------------------
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set MyRange = ws1.Range("A1:A10") ' values to look up
    Set LookupTable = ws2.Range("A1:B100")  ' lookup table
    Set LookupColumn = ws2.Range("A1:A100") ' lookup values
    '------------------------------------------------------
    '- loop through MyRange
    For Each c In MyRange
        MyFind = c.Value
        Set ToCell = c.Offset(0, 1)
        ToCell.Value = ""
        '------------------------------------------------
        '- Find matching values in the table
        Set FoundCell = LookupColumn.Find _
            (what:=MyFind, after:=LookupColumn.Cells(LookupColumn.Rows.Count, 1))
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            Do
                '- what to do if found
                FoundRow = FoundCell.Row
                ToCell.Value = ToCell.Value _
                    & LookupTable.Cells(FoundRow, 2).Value
                '--------------------------------------------
                Set FoundCell = LookupColumn.FindNext(FoundCell)
            Loop While Not FoundCell Is Nothing _
                And FoundCell.Address <> FirstAddress
        End If
    Next
    '-------------------------------------------------------
    rsp = MsgBox("done")
End Sub
 
Upvote 0
Brian,

many thanks for your response - I was afraid that it would have to be a macro driven resolution. As usual, other events have conspired to push this down my list, but I will try it out as soon as I can.

Regards

Steve
 
Upvote 0

Forum statistics

Threads
1,214,632
Messages
6,120,655
Members
448,975
Latest member
sweeberry

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