LookupConcat.vba 1.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869
  1. Option Explicit
  2. Function VLookupConcat(Search_string As String, _
  3. Search_in_col As Range, Return_val_col As Range)
  4. Dim i As Long
  5. Dim result As String
  6. For i = 1 To Search_in_col.Count
  7. If Search_in_col.Cells(i, 1) = Search_string Then
  8. result = result & ", " & Return_val_col.Cells(i, 1).value
  9. End If
  10. Next
  11. VLookupConcat = Trim(result)
  12. End Function
  13. Function LookupConcatUnique(Search_string As String, _
  14. Search_in_col As Range, Return_val_col As Range)
  15. Dim i As Long
  16. Dim temp() As Variant
  17. Dim result As String
  18. ReDim temp(0)
  19. For i = 1 To Search_in_col.Count
  20. If Search_in_col.Cells(i, 1) = Search_string Then
  21. temp(UBound(temp)) = Return_val_col.Cells(i, 1).value
  22. ReDim Preserve temp(UBound(temp) + 1)
  23. End If
  24. Next
  25. If temp(0) <> "" Then
  26. ReDim Preserve temp(UBound(temp) - 1)
  27. Unique temp
  28. For i = LBound(temp) To UBound(temp)
  29. result = result & " " & temp(i)
  30. Next i
  31. LookupConcatUnique = Trim(result)
  32. Else
  33. LookupConcatUnique = ""
  34. End If
  35. End Function
  36. Function Unique(tempArray As Variant)
  37. Dim coll As New Collection
  38. Dim value As Variant
  39. On Error Resume Next
  40. For Each value In tempArray
  41. If Len(value) > 0 Then coll.Add value, CStr(value)
  42. Next value
  43. On Error GoTo 0
  44. ReDim tempArray(0)
  45. For Each value In coll
  46. tempArray(UBound(tempArray)) = value
  47. ReDim Preserve tempArray(UBound(tempArray) + 1)
  48. Next value
  49. End Function