View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Simon Shaw Simon Shaw is offline
external usenet poster
 
Posts: 60
Default New Function: ConcatenateIF

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
_________________________________________________


"Simon Shaw" wrote:

Thanks Julie, I have improved the variable names to make it more clear and
changed the order of the variables to match SUMIF

------------------------------------
Public Function ConcatenateIF(Match_Range As Range, _
Criteria_Range As Range, _
Concatenate_Range As Range) As
String

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

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).Value
Else
Criteria_Value = Criteria_Range.Value
End If

ConcatenateIF = ""

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

End Function
---------------------------------------

Simon


"JulieD" wrote:

Hi Simon

i actually couldn't get this to work ... maybe i'm using the wrong info in
the wrong parameters
A1:A10 contains the range i want to check for the criteria
G10 contains the criteria
K1:K10 contains the range i want to concatenate

so i set
Lookup_Value_Range to A1:A10
Match_Range to G10
Concatenate_Range to K1:K10

and got a #VALUE as a result.

I tested it with both text and numbers in A1:A10 and G10
what am i doing wrong?

Cheers
JulieD



"Simon Shaw" <simonATsimonstoolsDOTcom wrote in message
...
I previously posted a question looking for a Concatenate function similar
to
SumIF. This is my solution:

Public Function ConcatenateIF(Lookup_Value_Range As Range, _
Match_Range As Range, _
Concatenate_Range As Range) As
String

Dim x As Long
Dim Lookup_Value As String
Dim Source_Cell As Range
Dim Lookup_Row_Count As Long

Set Source_Cell = Application.Caller
Lookup_Value = Lookup_Value_Range _
.Cells(Source_Cell.Row - Lookup_Value_Range.Row + 1, 1).Value

ConcatenateIF = ""

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

End Function

-----------------------------------------

Thanks

Simon Shaw
www.simontools.com