View Full Version : Solved: Vlookup with Multiple Returns

08-01-2005, 10:13 PM

I am performing a vlookup where the values I am looking up have more than match.

Rather than just 1 value, I would like all the matches to be listed. Ideally, I would like all matches to appear in 1 cell with commas separating them, but perhaps that is asking to much.

Otherwise, I would like the matches to be listed in columns moving towards the right of my formula cell.

I have searched high and low for the solution to this problem. Can anyone help me?

Thank you

: pray2:

08-01-2005, 10:30 PM
I have solved my problem. Hooray

I hope this helps someone else.

Option Explicit
Function mvlookup(lookupValue, tableArray As Range, colIndexNum As Long, _
Optional NotUsed As Variant) As Variant

Dim initTable As Range
Dim myRowMatch As Variant
Dim myRes() As Variant
Dim myStr As String
Dim initTableCols As Long
Dim i As Long
Dim ubound_myRes As Long

Set initTable = Nothing
On Error Resume Next
Set initTable = Intersect(tableArray, _
On Error GoTo 0

If initTable Is Nothing Then
mvlookup = CVErr(xlErrRef)
Exit Function
End If

initTableCols = initTable.Columns.Count

i = 0
myRowMatch = Application.Match(lookupValue, initTable.Columns(1), 0)

If IsError(myRowMatch) Then
Exit Do
i = i + 1
ReDim Preserve myRes(1 To i)
myRes(i) _
= initTable(1).Offset(myRowMatch - 1, colIndexNum - 1).Text
If initTable.Rows.Count <= myRowMatch Then
Exit Do
End If
On Error Resume Next
Set initTable = initTable.Offset(myRowMatch, 0) _
.Resize(initTable.Rows.Count - myRowMatch, _
On Error GoTo 0
If initTable Is Nothing Then
Exit Do
End If
End If

If i = 0 Then
mvlookup = CVErr(xlErrNA)
Exit Function
End If

myStr = ""
For i = LBound(myRes) To UBound(myRes)
myStr = myStr & ", " & myRes(i)
Next i

mvlookup = Mid(myStr, 3)

End Function

08-04-2005, 12:51 AM
I got error #name when i applied this formula.

08-04-2005, 03:47 AM
Works fine for me. It works the same way as vlookup, but you do not need the true or false at the end.

So it's:


Just dump it in a module, and away you go.

Also, make sure to delete that Times New Roman business at the top that I forgot to remove. But I am sure you did already.

08-04-2005, 04:00 AM
Check this file with error #name?

im using xl 98:beerchug:

08-04-2005, 04:48 PM
Fixed! I just deleted the font info that should not have been included, and moved the macro to a module, rather than sitting in a workbook.

And there you have it. :thumb

Ken Puls
08-04-2005, 09:47 PM
Hey Jacksonworld!

Nice work! Just an FYI, I've removed those extra font tags from the post in case anyone else happens upon it.


04-23-2006, 06:35 PM
Hi, that works great!

However im having a little problem getting it to work in code.
When i try to put a range from another sheet in another file, initTable Is Nothing.

What im trying to do is pass in a different range into the active workbook:

Filename: NewFile.xls
Sheetname: Sheet1
Range: Entire Column A - Column F

Set xlApp = New Excel.Application
Set xlWbk = xlApp.Workbooks.Open("NewFile.xls")
Dim strResult As String

strResult = mvlookup("A1", xlApp.Application.Worksheets("Sheet1").Range("A:F"), 2, False)

Thanks for any help!