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