How search two values and concatenate the result from one column !!!

**pub** · 12-21-2017, 03:17 PM

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

**snb** · 12-21-2017, 03:25 PM

**pub** · 12-21-2017, 03:38 PM

I replaced "!!!" with "?". Now, can you give me a solution to my issue ?

**Admin** · 12-22-2017, 08:39 AM

Hi

You could try this UDF.

Use it as

=CONCATIFS($C$2:$C$50,", ",$A$2:$A$50,F$1)

or

=CONCATIFS($C$2:$C$50,", ",$A$2:$A$50,F$1,$B$2:$B$50,$E2)

Code:

Option Explicit

Function CONCATIFS(ByVal ConcatCol As Variant, ByVal Delim As String, ParamArray ParamA() As Variant) As String
    
    '//ParamA=each pair should be Criteria range followed by it's criteria
    
    Dim lngLoopC        As Long
    Dim lngLoopR        As Long
    Dim lngLoop         As Long
    Dim lngCount        As Long
    Dim lngCounter      As Long
    Dim lngIndex        As Long
    Dim lngCase         As Long
    Dim varOP()         As Variant
    Dim strMatch        As String
    Dim blnTranspose    As Boolean
    
    If TypeOf ConcatCol Is Range Then
        If ConcatCol.Columns.Count > 1 And ConcatCol.Rows.Count = 1 Then
            blnTranspose = True
            ConcatCol = Application.Transpose(Application.Transpose(ConcatCol.Value2))
        ElseIf ConcatCol.Columns.Count = 1 And ConcatCol.Rows.Count > 1 Then
            ConcatCol = Application.Transpose(ConcatCol.Value2)
        End If
    End If
    
    For lngLoop = LBound(ParamA) To UBound(ParamA)
        If TypeOf ParamA(lngLoop) Is Range Then
            If blnTranspose Then
                ParamA(lngLoop) = Application.Transpose(Application.Transpose(ParamA(lngLoop).Value2))
            Else
                ParamA(lngLoop) = Application.Transpose(ParamA(lngLoop).Value2)
            End If
        End If
    Next
    
    ReDim varOP(1 To UBound(ConcatCol))
    lngCount = (1 + UBound(ParamA)) \ 2
    For lngLoopR = LBound(ConcatCol) To UBound(ConcatCol)
        lngCounter = 0
        For lngLoopC = LBound(ParamA) To UBound(ParamA) Step 2
            If LCase(ParamA(lngLoopC)(lngLoopR)) = LCase(ParamA(lngLoopC + 1)) Then
                lngCounter = lngCounter + 1
            End If
        Next
        If lngCount = lngCounter Then
            If Len(Trim(ConcatCol(lngLoopR))) Then
                If InStr(1, strMatch & "|", "|" & ConcatCol(lngLoopR) & "|", lngCase) = 0 Then
                    lngIndex = lngIndex + 1
                    varOP(lngIndex) = ConcatCol(lngLoopR)
                    strMatch = strMatch & "|" & ConcatCol(lngLoopR)
                End If
            End If
        End If
    Next
    If lngIndex Then
        ReDim Preserve varOP(1 To lngIndex)
        CONCATIFS = Join(varOP, Delim)
    End If
    
End Function

**pub** · 12-22-2017, 11:56 AM

Thanks for the reply but it does not work.
I updated the existing module using the VBA code above but when I try to use the two recommended formulas, it displays: #NAME?
So, what's the reason for it being displayed:#NAME?

**Admin** · 12-22-2017, 11:08 PM

Where did you put the code? The code should go into a standard module.

**pub** · 12-27-2017, 01:38 PM

I put the code in a VBA module. How can I check if it's a standard module?

**Admin** · 12-28-2017, 08:37 AM

In the VBE window, Go to Insert > Module

**pub** · 12-28-2017, 11:45 AM

Thanks. Now it is working.

There would still be a last problem where I would like to use CONCATIFS (see the attached file below).
So, there are three columns in this file: Motivation, Names and A + B. Since Column B is filled randomly, depending on the B values, column C will be automatically populated. In the example from the file, now in cell F2, I would like to list (separated by ";") only the content of C2, C3 and C4 cells.