View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
JulieD JulieD is offline
external usenet poster
 
Posts: 618
Default New Function: ConcatenateIF

Hi Jim

(Simon sorry to butt in here)

you might like to try a Concatenate IF fuction that Harald Staff and I
cobbled together ....
---------
Public Function CONCAT_IF(ConcCheck As Range, _
ConcCrit As Variant, _
Optional ConcRange As Range, _
Optional DelimitWith As String) As String
'written by JulieD and Harald Staff
'ConcCheck - range to check for the criteria
'ConcCrit - the criteria
'ConcRange - range to concatenation
'DelimitWith - the delimination character(s)

Dim Cel As Range
Dim i As Long, j As Long
Dim checkarray() As String
Dim rangearray() As String

If ConcRange Is Nothing Then Set ConcRange = ConcCheck

i = ConcCheck.Count
j = ConcRange.Count

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
-------

---------
Let us know how you go

Cheers
JulieD

wrote in message
oups.com...
Simon,

Your ConcatenateIF Function is just what I was looking for, but I can't
get it to work.

My scenario =

A B C
1 T T Al
2 T Henry
3 F Joe
4 F Mike
5 T Jim


My desired result =

AlHenryJim

My Formula=

=ConcatenateIF(B1:B5,"="&A1,C1:C5)

My actual result =

#Name?

Your Function Code=

Public Function ConcatenateIF(Match_Range As Range, Criteria_Range As
Range, _
Concatenate_Range As Range) As String
' created by Simon Shaw
' Match_Range - Range to match the criteria against
' Criteria_Range - Range to get the criteria to match against the
Match_Range
' if range is more than one cell it will pull the value
' from the same row as the application.caller
' Concatenate_Range - Range to concatenate text from
' Match_Range and Concatenate_Range must be the same size
Dim x As Long
Dim Criteria_Value As String
Dim Source_Cell As Range
Dim Match_Row_Count As Long
If Match_Range.Rows.Count < Concatenate_Range.Rows.Count Then
Exit Function
End If
Set Source_Cell = Application.Caller
If Criteria_Range.Rows.Count 1 Then
Criteria_Value = Criteria_Range _
.Cells(Source_Cell.Row - Criteria_Range.Row + 1, 1).Text
Else
Criteria_Value = Criteria_Range.Text
End If
ConcatenateIF = ""
If Criteria_Value < "" Then
Match_Row_Count = Match_Range.Rows.Count
For x = 1 To Match_Row_Count
If Criteria_Value = Match_Range.Cells(x, 1).Text _
And Concatenate_Range.Cells(x, 1).Value < 0 Then
If ConcatenateIF = "" Then
ConcatenateIF = Concatenate_Range.Cells(x, 1).Text
Else
ConcatenateIF = ConcatenateIF & Chr(10) & _
Concatenate_Range.Cells(x, 1).Value
End If
End If
Next x
End If
End Function

What am I missing?

Thanks,
Jim


Simon Shaw wrote:
More Improvements: Thanks JulieD
__________________________________________

Public Function ConcatenateIF(Match_Range As Range, _
Criteria_Range As Range,

_
Concatenate_Range As

Range) As
String

' created by Simon Shaw
' Match_Range - Range to match the criteria against
' Criteria_Range - Range to get the criteria to match against the

Match_Range
' if range is more than one cell it will pull the value
' from the same row as the application.caller
' Concatenate_Range - Range to concatenate text from
' Match_Range and Concatenate_Range must be the same size

Dim x As Long
Dim Criteria_Value As String
Dim Source_Cell As Range
Dim Match_Row_Count As Long

If Match_Range.Rows.Count < Concatenate_Range.Rows.Count Then
Exit Function
End If

Set Source_Cell = Application.Caller
If Criteria_Range.Rows.Count 1 Then
Criteria_Value = Criteria_Range _
.Cells(Source_Cell.Row - Criteria_Range.Row + 1, 1).Text
Else
Criteria_Value = Criteria_Range.Text
End If

ConcatenateIF = ""

If Criteria_Value < "" Then
Match_Row_Count = Match_Range.Rows.Count
For x = 1 To Match_Row_Count
If Criteria_Value = Match_Range.Cells(x, 1).Text _
And Concatenate_Range.Cells(x, 1).Value < 0 Then
If ConcatenateIF = "" Then
ConcatenateIF = Concatenate_Range.Cells(x, 1).Text
Else
ConcatenateIF = ConcatenateIF & Chr(10) & _
Concatenate_Range.Cells(x, 1).Value
End If
End If
Next x
End If

End Function
_________________________________________________