Solved: VBA special vlookup function

[xiaoxuesheng]

Hi all,

I need an Excel vlookup function that can retrieve several results, and concatenate them in a single cell, with a coma as a separator.

I found on the net a function that does the job, the only issue is that it doesn't remove duplicates.

Respect and credits to who wrote this function, I am sorry, I cannot remember where I found it:

Function VlookMulti(lookup_value, table_array As Range, col_index_num) As Variant
'A multiple result user-defined function (UDF) version of VLOOKUP.
'Returns list of all values from table that have the corresponding
'lookup value. Returns a comma-separated list of values as a text
'string. Works just like Excel VLOOKUP if only one value exists in
'table, except lacks range_lookup argument because this function
'will only do an EXACT lookup.
'Also, just like VLOOKUP, the first column of the table_array must
'be sorted in ascending order.

Dim iRow As Long 'Row index in table_array
Dim nFound As Integer 'number of matches found

iRow = 1
nFound = 0
Do
If table_array(iRow, 1) = lookup_value Then
nFound = nFound + 1
If nFound = 1 Then
VlookMulti = table_array(iRow, col_index_num)
Else
VlookMulti = VlookMulti & "," & table_array(iRow, col_index_num)
End If
ElseIf nFound > 0 Then
Exit Do
End If
iRow = iRow + 1
Loop Until iRow > table_array.Rows.Count
If nFound = 0 Then VlookMulti = CVErr(xlErrNA)
End Function

Example:

a.Michelle
b.Martin
c.Andy
d.Paul
a.Helen
f.Jon
a.Michelle
f.Jack
r.Ed
f.Liz
a.Steven

Using the function above on [a] would retrieve: [Michelle,Helen,Michelle,Steven].
What I need is: [Michelle,Helen,Steven]

Is there a way to modify the function to get this result?

Thank you for your help.

XXS

[mdmackillop]

A different methodology but using the same parameters
Option Explicit

Function VlookMulti(lookup_value, table_array As Range, col_index_num) As String

Dim MyCol, d As String, Data As String
Dim cel As Range, c
On Error Resume Next
Set MyCol = New Collection

For Each cel In table_array.Columns(1).Cells
If cel.Value = lookup_value Then
d = cel.Offset(, col_index_num - 1)
MyCol.Add d, d
End If
Next

For Each c In MyCol
Data = Data & c & ", "
Next

VlookMulti = Left(Data, Len(Data) - 2)

End Function

[Bob Phillips]

Function VlookMulti(lookup_value, table_array As Range, col_index_num) As Variant
Dim iRow As Long 'Row index in table_array
Dim iFound As Long
Dim vecMatches As Variant

iRow = 1
ReDim vecMatches(1 To table_array.Rows.Count)
Do

If table_array(iRow, 1).Value = lookup_value Then

If IsError(Application.Match(table_array(iRow, col_index_num).Value, vecMatches, 0)) Then

iFound = iFound + 1
vecMatches(iFound) = table_array(iRow, col_index_num).Value
End If
End If

iRow = iRow + 1
Loop Until iRow > table_array.Rows.Count

If iFound = 0 Then

VlookMulti = CVErr(xlErrNA)
Else

For i = 1 To iFound

VlookMulti = VlookMulti & vecMatches(i) & ","
Next i

VlookMulti = Left$(VlookMulti, Len(VlookMulti) - 1)
End If
End Function

[mikerickson]

The ConcatIf function in post #8 of this link has a NoDuplicates argument.

http://www.vbaexpress.com/forum/showthread.php?t=21926&highlight=ConcatIf

[xiaoxuesheng]

Thank you so much for your help guys!
I used Mdmackillop's solution and it does exactly what I want!
Thanks to you all.

XXS