PDA

View Full Version : 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.


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
I don't like exclamation marks.



https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9iHOYYpaA bC (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9iHOYYpaA bC)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgxuL6YCUckeUIh9hoh4AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgxuL6YCUckeUIh9hoh4AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7G-bVm8_- (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7G-bVm8_-)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7EqbG23kg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7EqbG23kg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7KvJXmK 8o (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7KvJXmK 8o)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7E1gwg4Aq (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7E1gwg4Aq)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgywFtBEpkHDuK55r214AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgywFtBEpkHDuK55r214AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79hNGvJ bu (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79hNGvJ bu)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79YAfa2 4T (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79YAfa2 4T)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79M1SYH 1E (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79M1SYH 1E)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78SxhXT nR (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78SxhXT nR)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

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)



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(Concat Col.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.

Admin
12-29-2017, 02:51 PM
In D2 and copied down,

=LEN(B2)>0

Now use;

=CONCATIFS(C2:C11,";",D2:D11,TRUE)