Function ConcatIf(ByVal Compare_Range As Range, _
Optional ByVal Criteria As Variant, _
Optional ByVal Concat_Range As Range, _
Optional ByVal Delimiter As String = "", _
Optional ByVal dotrim As Boolean = False) As String

Dim i As Long, j As Long
Dim doCompare As Boolean, doConcat As Boolean

If Compare_Range Is Nothing Then Exit Function
If Concat_Range Is Nothing Then Set Concat_Range = Compare_Range

doCompare = Not (IsMissing(Criteria))
If doCompare Then
If IsObject(Criteria) Then
Criteria = CStr(Criteria.Value)
End If
End If

With Concat_Range
For j = 1 To .Columns.count
For i = 1 To .Rows.count
If .Cells(i, j) <> "" Then
doConcat = True
If doCompare Then
doConcat = (Application.CountIf(Compare_Range.Cells(i, j), Criteria) = 1)
End If
If doConcat Then
ConcatIf = ConcatIf & CStr(.Cells(i, j)) & Delimiter
End If
End If
Next i
Next j
End With

If dotrim And Len(Delimiter) > 0 And Len(ConcatIf) > 0 Then
ConcatIf = Left(ConcatIf, Len(ConcatIf) - Len(Delimiter))
End If

End Function

 

Advertisements