ConcatenateIfs Function

[charlee63]

Here is my VGA
Function ConcatenateIfs(CriteriaRange As Range, Condition As Variant, _
ConcatenateRange As Range, Optional Separator As String = ",") As Variant
Dim i As Long
Dim strResult As String
On Error GoTo ErrHandler
If CriteriaRange.Count <> ConcatenateRange.Count Then
ConcatenateIfs = CVErr(xlErrRef)
Exit Function
End If
For i = 1 To CriteriaRange.Count
If CriteriaRange.Cells(i).Value = Condition Then
strResult = strResult & Separator & ConcatenateRange.Cells(i).Value
End If
Next i
If strResult <> "" Then
strResult = Mid(strResult, Len(Separator) + 1)
End If
ConcatenateIfs = strResult
Exit Function
ErrHandler:
ConcatenateIfs = CVErr(xlErrValue)
End Function

Result[TABLE="width: 84"]
<tbody>[TR]
[TD]69444,69444,69444,69444,69444,69444,69444,69444,69444,69707,69707

Formula
=ConcatenateIfs('Compare - NYD'!$A$2:$A$500,A17,'Compare - NYD'!$B$2:$B$500,", ")[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]

How do I get Dups out?

 

[Eric W]

Try:

Function ConcatenateIfs(CriteriaRange As Range, Condition As Variant, _
ConcatenateRange As Range, Optional Separator As String = ",", Optional NoDups As Boolean = False) As Variant
Dim i As Long, strResult As String, MyDict As Object

    On Error GoTo ErrHandler
    If CriteriaRange.Count <> ConcatenateRange.Count Then
        ConcatenateIfs = CVErr(xlErrRef)
        Exit Function
    End If
    Set MyDict = CreateObject("Scripting.Dictionary")
        
    For i = 1 To CriteriaRange.Count
        If CriteriaRange.Cells(i).Value = Condition Then
            strResult = strResult & Separator & ConcatenateRange.Cells(i).Value
            MyDict(CStr(ConcatenateRange.Cells(i).Value)) = 1
        End If
    Next i
    
    ConcatenateIfs = IIf(NoDups, Join(MyDict.keys, Separator), Mid(strResult, Len(Separator) + 1))
    
    Exit Function
    
ErrHandler:
    ConcatenateIfs = CVErr(xlErrValue)

End Function

And call it with an extra (optional) parameter like this:

=ConcatenateIfs('Compare - NYD'!$A$2:$A$500,A17,'Compare - NYD'!$B$2:$B$500,", ",TRUE)

to remove duplicates.

 

[charlee63]

Thanks

 

[Eric W]

You're welcome.