concatenate like sumif

[Guest]

Is there a function like SUMIF for text values that concatenates rather than
sums?

I have a set of data as follows:

Truck No. Product Comments
----------- --------- ------------------
123 R-Gas Fully Reconciled
456 R-Gas Tank Dried
123 G-Gas Refilled

There are other columns of numbers. I then have a summary row for each truck
number using sumif for the number columns, but I need to concatenate the
comments in the summary row for say truck 123 to be:
"R-Gas"&":"&" Fully Reconciled"&", "&Char(10)&"R-Gas"&":"&" Refilled"
with the results in one text wrapped cell displayed as follows:
R-Gas: Fully Reconciled
R-Gas: Refilled

Thanks

 

[Sandy Mann]

Simon,

Would a custom function do?
This is a simplified example that assumes that the data is in columns A:C
starting in Row 1.

Functions cannot change the environment so you would have to select to wrap
text and expand the row height yourself.

Public Function Test(TruckNo) As String
Dim EndRow As Long
Dim NN As String
Dim x as Long

EndRow = Cells(Rows.Count, 1).End(xlUp)

For x = 1 To EndRow
If Cells(x, 1).Value = TruckNo Then NN = NN & Cells(x, 2).Value _
& " : " & Cells(x, 3).Value & Chr(10)
Next x

NN = Left(NN, Len(NN) - 1)

Test = NN

End Function

HTH

Sandy

 

[Jim May]

Nice code Sandy;
Using the example I Inserted 5 rows at top of sheet
before showing the table (with 3 header columns on Row 6, data begins on
Row7 (A:C)
Where your code shows:
For x = 1 To EndRow
I would have thought that I would need to substitute "7" for your 1
but it doesn't seem to matter...
I'm sure I'm missing something here, but what?
TIA,

 

[Jim May]

Looking further at the code:
For x = 1 To EndRow
obviously it is starting with Row1 everytime and
tests for TruckNo, retuning nothing if there is nothing,
so in my case it doesn't pick up anything until it gets
to Row7, right? hummmm beginner coder here....
Thanks,
Jim

 

[Sandy Mann]

Looking further at the code:
For x = 1 To EndRow
obviously it is starting with Row1 everytime and
tests for TruckNo, retuning nothing if there is nothing,
so in my case it doesn't pick up anything until it gets
to Row7, right?

Jim,

Yes that is right. So it is bad coding really because it *could* find a
TruckNo outside of the table of data. It would be much better therefore,
providing that you have at least one blank cell at the end of the table
before any other data, to start at your start of table and count down thus:

Public Function Test(TruckNo) As String
Dim EndRow As Long
Dim NN As String
Dim x As Long

EndRow = Range("A7").End(xlDown).Row

For x = 7 To EndRow
If Cells(x, 1).Value = TruckNo Then NN = NN & Cells(x, 2).Value _
& " : " & Cells(x, 3).Value & Chr(10)
Next x

NN = Left(NN, Len(NN) - 1)

Test = NN

End Function

That will limit the code to looking at the table of data only - PROVIDED
that you do not add any rows above the start of the table. If that is
liable to happen then you would have to code in a way of finding the start
of the table. (VBA is not part of Excel so it does not alter references the
way that true functions do when rows or columns are changed.)

Regards

Sandy

 

[Jim May]

Sandy:
Thanks for taking the extra time to clear my question(s).
Much appreciated,
Jim

 

[Guest]

The brilliance of the people on this site never ceases to amaze me... thanks
again

 

[Guest]

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

 

[JulieD]

another option:
---------------

Public Function CONCAT_IF(ConcCheck As Range, ConcRange As Range, ConcCrit
As Variant, _

Optional DelimitWith As String) As String

'created by Gdall - with acknowledgement to Harold Staff

'ConcCheck - range to check for the criteria

'ConcRange - range to concatenation

'NOTE the above two ranges must be indentically sized.

'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

 

[Guest]

thanks, I should have tested my code better first... I will be more careful
next time I post...

Simon

 

[JulieD]

Hi Simon

don't apologise .. my comments weren't meant as a criticism ...

Cheers
JulieD

 

[Guest]

Question:

Does loading the Ranges into arrays and using:
For each cell in the myRange
speed up the calculation time? Is this better than using the

for x = 1 to myRange.Rows.Count
check_something = myRange.Cells(x, 1).Value
next x

style of coding

 

[Guest]

not to worry... I appreciate your comments and testing.

Thanks
Simon

 

[Guest]

Improved Solution: (thanks for your help 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