Listing text within a cell

[Neil Pearce]

Hi all,

Column A specifies a room type: corridor, office, toilet etc.
Column B specifies the floor finish chosen for that room: carpet, vinyl,
tiles etc.

There is a seperate worksheet where the floor finishes are summarised.
After each flooring type I wish to add a list of all the rooms within which a
particular floor finish has been specified, i.e. list out the rooms where
carpet has been selected. Ideally this would be listed in one cell.

Any ideas?


Thanking-you in advance,

Cheers,

Neil

 

[Gary''s Student]

Assuming there exists a worksheet called Summary. Enter and run this macro:

Sub flooring()
Set ss = Sheets("Summary")
ss.Range("A:B").Clear
n = Cells(Rows.Count, 1).End(xlUp).Row
ss.Cells(1, 1).Value = Cells(1, 2).Value
k = 2
For i = 2 To n
Set bb = Range("B1:B" & i)
cnt = Application.WorksheetFunction.CountIf(bb, Cells(i, 2))
If cnt = 1 Then
ss.Cells(k, 1).Value = Cells(i, 2).Value
k = k + 1
End If
Next

For i = 1 To k - 1
flr = ss.Cells(i, 1).Value
For j = 1 To n
If flr = Cells(j, 2).Value Then
ss.Cells(i, 2).Value = ss.Cells(i, 2).Value & Cells(j, 1).Value
& ","
End If
Next
Next
End Sub

For example, if cols A&B of the data sheet contain:

bath room #2 tile
living room wood
hallway wood
family room wood
office wood
bath room #4 tile
bed room #1 wood
den wood
kitchen tile
bath room #3 tile
bath room #1 tile
dining room wood
basement carpet
bed room #4 carpet
bed room #2 carpet
bed room #3 carpet

The the macro would produce:

tile bath room #2,bath room #4,kitchen,bath room #3,bath room #1,
wood living room,hallway,family room,office,bed room #1,den,dining room,
carpet basement,bed room #4,bed room #2,bed room #3,

on the summary sheet.

 

[Neil Pearce]

I'll give it a go now, thank-you very much indeed.

You're a genius!


Cheers,

Neil

 

[Neil Pearce]

Hi Gary,

How would I adapt the below to enable the summary sheet listings to start on
a nominated row rather than row 1?


Cheers,

Neil

 

[Gary''s Student]

Use this version in place of the original:

Sub flooring()
Set ss = Sheets("Summary")
ss.Range("A:B").Clear
offst = 4
n = Cells(Rows.Count, 1).End(xlUp).Row
ss.Cells(1 + offst, 1).Value = Cells(1, 2).Value
k = 2
For i = 2 To n
Set bb = Range("B1:B" & i)
cnt = Application.WorksheetFunction.CountIf(bb, Cells(i, 2))
If cnt = 1 Then
ss.Cells(k + offst, 1).Value = Cells(i, 2).Value
k = k + 1
End If
Next

For i = 1 To k - 1
flr = ss.Cells(i + offst, 1).Value
For j = 1 To n
If flr = Cells(j, 2).Value Then
ss.Cells(i + offst, 2).Value = ss.Cells(i + offst, 2).Value &
Cells(j, 1).Value & ","
End If
Next
Next
End Sub

The line with offst=4 tell the program how many lines to skip in the summary
sheet before entering data. Adjust this line to suit your needs.