snippets/microsoft/ms-office/excel/functions/LookupConcat.vba

Option Explicit

Function VLookupConcat(Search_string As String, _
  Search_in_col As Range, Return_val_col As Range)

Dim i As Long
Dim result As String

For i = 1 To Search_in_col.Count
  If Search_in_col.Cells(i, 1) = Search_string Then
    result = result & ", " & Return_val_col.Cells(i, 1).value
  End If
Next

VLookupConcat = Trim(result)

End Function


Function LookupConcatUnique(Search_string As String, _
  Search_in_col As Range, Return_val_col As Range)

Dim i As Long
Dim temp() As Variant
Dim result As String
ReDim temp(0)

For i = 1 To Search_in_col.Count
  If Search_in_col.Cells(i, 1) = Search_string Then
    temp(UBound(temp)) = Return_val_col.Cells(i, 1).value
    ReDim Preserve temp(UBound(temp) + 1)
  End If
Next

If temp(0) <> "" Then
    ReDim Preserve temp(UBound(temp) - 1)
    Unique temp
    For i = LBound(temp) To UBound(temp)
        result = result & " " & temp(i)
    Next i
    LookupConcatUnique = Trim(result)
Else
    LookupConcatUnique = ""
End If

End Function

Function Unique(tempArray As Variant)

Dim coll As New Collection
Dim value As Variant

On Error Resume Next
For Each value In tempArray
    If Len(value) > 0 Then coll.Add value, CStr(value)
Next value
On Error GoTo 0

ReDim tempArray(0)

For Each value In coll
    tempArray(UBound(tempArray)) = value
    ReDim Preserve tempArray(UBound(tempArray) + 1)
Next value
    
End Function