J
JulieD
Hi Harald
following on from our previous conversation would you like to test the
following:
---------
Public Function CONCAT_IF(ConcCheck As Range, ConcRange As Range, ConcCrit
As Variant, _
Optional DelimitWith As String) As String
'ConcCheck - range to check for the criteria
'ConcRange - range to concatenation
'ConcCrit - the criteria
'DelimitWith - the delimination character(s)
Dim Cel As Range
Dim i As Long
Dim checkarray() As String
Dim rangearray() As String
i = Application.WorksheetFunction.CountA(ConcCheck)
j = Application.WorksheetFunction.CountA(ConcRange)
If i <> j Then
Exit Function
End If
ReDim checkarray(i - 1)
ReDim rangearray(i - 1)
i = 0
For Each Cel In ConcCheck
checkarray(i) = Cel.Text
i = i + 1
Next
i = 0
For Each Cel In ConcRange
rangearray(i) = Cel.Text
i = i + 1
Next
For i = 0 To j - 1
If checkarray(i) = ConcCrit Then CONCAT_IF = _
CONCAT_IF & rangearray(i) & DelimitWith
Next
If CONCAT_IF <> "" Then _
CONCAT_IF = Left$(CONCAT_IF, _
Len(CONCAT_IF) - Len(DelimitWith))
End Function
following on from our previous conversation would you like to test the
following:
---------
Public Function CONCAT_IF(ConcCheck As Range, ConcRange As Range, ConcCrit
As Variant, _
Optional DelimitWith As String) As String
'ConcCheck - range to check for the criteria
'ConcRange - range to concatenation
'ConcCrit - the criteria
'DelimitWith - the delimination character(s)
Dim Cel As Range
Dim i As Long
Dim checkarray() As String
Dim rangearray() As String
i = Application.WorksheetFunction.CountA(ConcCheck)
j = Application.WorksheetFunction.CountA(ConcRange)
If i <> j Then
Exit Function
End If
ReDim checkarray(i - 1)
ReDim rangearray(i - 1)
i = 0
For Each Cel In ConcCheck
checkarray(i) = Cel.Text
i = i + 1
Next
i = 0
For Each Cel In ConcRange
rangearray(i) = Cel.Text
i = i + 1
Next
For i = 0 To j - 1
If checkarray(i) = ConcCrit Then CONCAT_IF = _
CONCAT_IF & rangearray(i) & DelimitWith
Next
If CONCAT_IF <> "" Then _
CONCAT_IF = Left$(CONCAT_IF, _
Len(CONCAT_IF) - Len(DelimitWith))
End Function