DJE
04-02-2014, 09:26 PM
The LookUpConcat UDF helped me greatly, so I wanted to contribute this enhanced version.
This version works like LookUpConcat, but allows you to search for multiple criteria and it concatenates all results. The search terms are specified as a comma separated list by default, but you can optionally specify any delimiter.
Function Multi_LookUpConcat(ByVal SearchList As String, SearchRange As Range, ReturnRange As Range, _
Optional SearchListDelimiter As String = ",", _
Optional Delimiter As String = " ", _
Optional MatchWhole As Boolean = True, _
Optional UniqueOnly As Boolean = False, _
Optional MatchCase As Boolean = False)
Dim X As Long, CellVal As String, ReturnVal As String, Result As String
'Parse the SearchList into Strings
' Spaces next to the delimiters will be ignored
Dim SearchString As String
Dim List As String
Dim C1 As Integer
Dim C2 As Integer
If StrComp(SearchList, "") = 0 Then
Multi_LookUpConcat = ""
ElseIf (SearchRange.Rows.Count > 1 And SearchRange.Columns.Count > 1) Or _
(ReturnRange.Rows.Count > 1 And ReturnRange.Columns.Count > 1) Then
Multi_LookUpConcat = CVErr(xlErrRef)
Else
SearchList = SearchList & SearchListDelimiter 'Ensure that it runs at least once
C1 = 1
C2 = InStr(C1, SearchList, SearchListDelimiter)
While C2 > 0
SearchString = Trim(Mid(SearchList, C1, C2 - C1))
If Not MatchCase Then SearchString = UCase(SearchString)
For X = 1 To SearchRange.Count
If MatchCase Then
CellVal = SearchRange(X).Value
Else
CellVal = UCase(SearchRange(X).Value)
End If
ReturnVal = ReturnRange(X).Value
If MatchWhole And CellVal = SearchString Then
If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
Result = Result & Delimiter & ReturnVal
ElseIf Not MatchWhole And CellVal Like "*" & SearchString & "*" Then
If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
Result = Result & Delimiter & ReturnVal
End If
Continue:
Next
' Advance the pointers to search for the next element
C1 = C2 + 1
C2 = InStr(C1, SearchList, SearchListDelimiter)
Wend
Multi_LookUpConcat = Mid(Result, Len(Delimiter) + 1)
End If
End Function
This version works like LookUpConcat, but allows you to search for multiple criteria and it concatenates all results. The search terms are specified as a comma separated list by default, but you can optionally specify any delimiter.
Function Multi_LookUpConcat(ByVal SearchList As String, SearchRange As Range, ReturnRange As Range, _
Optional SearchListDelimiter As String = ",", _
Optional Delimiter As String = " ", _
Optional MatchWhole As Boolean = True, _
Optional UniqueOnly As Boolean = False, _
Optional MatchCase As Boolean = False)
Dim X As Long, CellVal As String, ReturnVal As String, Result As String
'Parse the SearchList into Strings
' Spaces next to the delimiters will be ignored
Dim SearchString As String
Dim List As String
Dim C1 As Integer
Dim C2 As Integer
If StrComp(SearchList, "") = 0 Then
Multi_LookUpConcat = ""
ElseIf (SearchRange.Rows.Count > 1 And SearchRange.Columns.Count > 1) Or _
(ReturnRange.Rows.Count > 1 And ReturnRange.Columns.Count > 1) Then
Multi_LookUpConcat = CVErr(xlErrRef)
Else
SearchList = SearchList & SearchListDelimiter 'Ensure that it runs at least once
C1 = 1
C2 = InStr(C1, SearchList, SearchListDelimiter)
While C2 > 0
SearchString = Trim(Mid(SearchList, C1, C2 - C1))
If Not MatchCase Then SearchString = UCase(SearchString)
For X = 1 To SearchRange.Count
If MatchCase Then
CellVal = SearchRange(X).Value
Else
CellVal = UCase(SearchRange(X).Value)
End If
ReturnVal = ReturnRange(X).Value
If MatchWhole And CellVal = SearchString Then
If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
Result = Result & Delimiter & ReturnVal
ElseIf Not MatchWhole And CellVal Like "*" & SearchString & "*" Then
If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
Result = Result & Delimiter & ReturnVal
End If
Continue:
Next
' Advance the pointers to search for the next element
C1 = C2 + 1
C2 = InStr(C1, SearchList, SearchListDelimiter)
Wend
Multi_LookUpConcat = Mid(Result, Len(Delimiter) + 1)
End If
End Function