Concantenate using VBA?

[cornishbloke]

This is really bugging me but I'm sure it can be done...

I want to concantenate all the values from one column that match
given criteria - into one cell. I have tried using workshee
functions but it's getting too complicated - how would I do this usin
VBA?

e.g.

Column A - Column B
1)oranges - box3
2)apples - box2
3)pears - box2
4)bananas - box1
5)peaches - box2

using the above example I would like Column C to show what else is i
the box with the item already shown on that row, e.g.

Column A - Column B - Column C
1)oranges - box3 - sole item
2)apples - box2 - pears, peaches
3)pears - box2 - apples, peaches
4)apples - box1 - sole item
5)peaches- box2 - apples, pears

At this stage I'm not concerned about the order items are shown i
Column C, although if it is possible to sort them from left to right i
alpha order this would be a bonus (e.g. C2 above would then rea
"peaches, pears").

Any Suggestions

 

[Patrick Molloy]

use a simple Pivot Table
set the Bowes as a row item and fruits as a column item
set the count of fruit items in the Data section.
The Grand Total column with show how many items in each
box

 

[Rick]

To concatenate with VBA just use "&".

For example:

Sub Sample1()
Cells(5, 5).Value = Cells(5, 6).Value & Cells(5, 7).Value
End Sub

To put a space and comma between the two use this:

Sub Sample2()
Cells(5, 5).Value = Cells(5, 6).Value & _
", " & Cells(5, 7).Value
End Sub

To sort the data, just record a macro while sorting and
study the programming language. To do this for many cells
you will have to loop through....

I'm not sure exactly what you are trying to do, but I hope
that gets you started.

 

[cornishbloke]

Thanks for the suggestions,

although Pivot tables do provide the same information, I specifically
wanted to show this information on a row-by-row basis next to the items
(as shown in my example).

One of the problems is that I don't know in advance which cells will be
'concantenated', the other is that the number of cells concantenated
will change depending upon how many cells meet the criteria.

Can anyone suggest a solution to the example I provided?

 

[Dick Kusleika]

CB

Try this user defined function

Function OtherItems(ThisRw As Range, AllRws As Range) As String

Dim cell As Range
Dim OthLst() As String
Dim i As Long, j As Long
Dim Temp As String
Dim ItmLst As String

i = 1

If Application.CountIf(AllRws.Columns(2), ThisRw.Value) = 1 Then
ItmLst = "Sole item"
Else

'Fill array by box
For Each cell In AllRws.Columns(2).Cells
If cell.Row <> ThisRw.Row Then
If cell.Value = ThisRw.Value Then
ReDim Preserve OthLst(1 To i)
OthLst(i) = cell.Offset(0, -1).Value
i = i + 1
End If
End If
Next cell

'Sort array
For i = LBound(OthLst) To UBound(OthLst) - 1
For j = i + 1 To UBound(OthLst)
If OthLst(i) > OthLst(j) Then
Temp = OthLst(j)
OthLst(j) = OthLst(i)
OthLst(i) = Temp
End If
Next j
Next i

For i = LBound(OthLst) To UBound(OthLst)
ItmLst = ItmLst & OthLst(i) & ","
Next i

ItmLst = Left(ItmLst, Len(ItmLst) - 1)
End If

OtherItems = ItmLst

End Function