New Function: ConcatenateIF

G

Guest

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
 
J

JulieD

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
 
G

Guest

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
 
J

JulieD

Hi Simon

that seems to work well with numerics in the Match and Criteria .. .but not
text .. BTW i've posted by CONCAT_IF function to your other post in .misc
you might like to have a look at it.

Cheers
JulieD
 
G

Guest

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

Guest

my email address is:

simon AT simonstools.com

I will reply with a sample spreadsheet.
 
J

jim.excel

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
 
J

JulieD

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

For Eachcell in Range tranpose comma seperated values to a list in D 4
modifiying a custom lookup function 2
Transfer array element offset value to a matched value 3
Excel VBA help: Text file formatting 19
function works okay, unless I save personal.xlsb 3
Passing a named range into a user defined function 2
Extracting Digits From Text 7
Save As and new workbook new name used in existing code 8

Top