1 Attachment(s)
How search two values and concatenate the result from one column ?
I have tried to implement the VBA below (I found it in this forum) in the attached excel file, but does not work with two search criteria !!! Please, some help.
Code:
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
