Originally Posted by
Agent100
So after some digging, I eventually found the below VBA. It works, but causes my spreadsheet to operate VERY slowly. Looking to use a macro now instead of calling the UDF in every cell....hopefully I am able to figure that out. In any event, figured it would be a good idea to share the VBA for the multiple criteria UDF. Here goes:
Function Lookup_concat(Search_stringA As String, Search_in_colA As Range, _
Search_stringB As String, Search_in_colB As Range, Return_val_col As Range)
Dim i As Long
Dim result As String
For i = 1 To Search_in_colA.Count
If Search_in_colA.Cells(i, 1) = Search_stringA And _
Search_in_colB.Cells(i, 1) = Search_stringB Then
result = result & " " & Return_val_col.Cells(i, 1).Value
End If
Next i
Lookup_concat = Trim(result)
End Function
The formula syntax in the cell would be:
=lookup_concat(cell of first value,'Sheet Name'!range:range,cell of second value,'Sheet name'!range:range,'Sheet name'!return results range: return results range)
For instance:
=lookup_concat(E$3,'Consolidated Data'!$I:$I,$B5,'Consolidated Data'!$E:$E,'Consolidated Data'!$A:$A)
Again, just trying to share what I have learned. Hopefully it helps others who are digging for the solution of multiple criteria. I will update if/when I am able to effectively write a macro to call this UDF vs. using the UDF (again, causes my workbook to perform SUPER slowly).
Cheers
First, for multiple columns, simple create a third column with the concatenation of the two. So the search string in your query would be E$3&$B5 and on Consolidated Data, you would put in column P (or some such) the values of column I and column E (i.e. =$I1&$E1 would go in P1 and copy it down). Then you'd just code the use 'Consolidated Data'!$P:$P for the search range.
OK, for those wanting a version that removes blanks, the following is a cleaned up (got rid of this bad "GoTo" calls) that has an additional flag to suppress blanks.
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, Optional SupressBlanks 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) Or _
(SearchRange.Count <> ReturnRange.Count) Then
LookUpConcat = "CVErr(xlErrRef)"
Else
Result = ""
If Not MatchCase Then
SearchString = UCase(SearchString)
End If
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 (Not SupressBlanks) Or Trim(ReturnVal) <> "" Then
If MatchWhole And CellVal = SearchString Then
If (Not UniqueOnly) Or InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) < 1 Then
If Trim(Result) > "" Then Result = Result & Delimiter
Result = Result & ReturnVal
End If
ElseIf (Not MatchWhole) And CellVal Like "*" & SearchString & "*" Then
If (Not UniqueOnly) Or InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) < 1 Then
If Trim(Result) > "" Then Result = Result & Delimiter
Result = Result & ReturnVal
End If
End If
End If
Next
LookUpConcat = Result
End If
End Function
Reply With Quote
Bookmarks