LookUp Value and Concatenate All Found Results

**Rick Rothstein** · 09-07-2016, 01:29 PM

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

**herman925** · 09-08-2016, 06:10 AM

Originally Posted by Rick Rothstein

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

Hi Rick, thanks for the help. I do still have some trouble with this code.

It will produce the word 'and' for even cells that only contain 1 name.

So for my example I gave previously, it worked well. However for cells that only contains 1 name, for example 'Rick Rothstein', it will become 'Rick and Rothstein'

Is it possible to make the rule (I'm, completely, a noob, on VB) such that for cells containing more than 1 value, the final 2 values can be separated by 'and' while others by comma only.

so:
(for 1 value) James Jones
(for 2 values) James Jones and Lillian Jones
(for 3 values) James Jones, Lillian Jones and Michael Jones

Sorry for the trouble, thank you.

**DIO** · 10-17-2016, 03:29 PM

Hi Rick,

Firstly, thanks for sharing this helpful code.

I have two questions, so I appreciate if you can help me.

1. Is it possible to skip duplicate results?

2. I have some empty cells; is it possible to skip them in the result.

Rick.jpg

**rwoodsum** · 10-26-2016, 12:52 AM

**Rick Rothstein** · 10-26-2016, 01:21 AM

Originally Posted by rwoodsum

I saved my workbook as macro enabled and saved your UDF code as a module. However when I enter the formula into my table I get the following error: Compile Error. Unexpected end function.

Is there a way to trouble shoot this?

Capture.jpg

It is hard to see that small picture, but if what is displayed in the picture is all of the code you copied, then you did not manage to copy all of the code there is.

**rwoodsum** · 10-26-2016, 01:25 AM

Originally Posted by Rick Rothstein

It is hard to see that small picture, but if what is displayed in the picture is all of the code you copied, then you did not manage to copy all of the code there is.

Oh gosh I didn't even see that the original code has a scroll bar