Originally Posted by
herman925
I do have one need from this code though, that is, to add 'and' for the last two sets to variables looked up by the code.
Here is the code where I replaced the last line of code before the last "End If" with two lines of code...
Code:
Function LookUpConcat(ByVal SearchString As String, _
SearchRange As Range, _
ReturnRange As Range, _
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
If (SearchRange.Rows.Count > 1 And SearchRange.Columns.Count > 1) Or _
(ReturnRange.Rows.Count > 1 And ReturnRange.Columns.Count > 1) Then
LookUpConcat = CVErr(xlErrRef)
Else
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
Result = Mid(Result, Len(Delimiter) + 1)
LookUpConcat = Application.Replace(Result, InStrRev(Result, Delimiter), Len(Delimiter), " and ")
End If
End Function |
Bookmarks