tough concatenation problem


Posted by Jeff Haferman on October 07, 2000 7:11 PM

Best described with an example:

column a column b
item1 description
of
item 1

item2 description
of
item2


I want to concatenate "description" "of" "item 1"
in "description of item 1" and put into the same
row as "item 1". There is always a blank row between
"item 1", "item 2", etc, but the "description" lines
can span 1 or more lines, and could be 3 lines for
item 1, 2 lines for item 1, etc.

For above example, I could place into column 3
=B1&" "&B2&" "&B3, but I want to figure out a smart
formula because I have 7000 rows in my worksheet.

Any ideas?

Posted by Celia on October 07, 2000 7:32 PM


Jeff
Assuming that Item 1 is in row 2, enter the following formula in C2 and fill down :-

=IF(MOD(ROW()-2,4)<>0,"",B2&" "&B3&" "&B4)

Celia

Posted by Celia on October 07, 2000 7:34 PM

Sorry, forgot to mention that each set of data MUST have 4 rows (including blank rows).
Celia

Posted by Celia on October 07, 2000 8:17 PM

Here's a macro


Sub Concatenate_Description()
Dim ColA As Range, cell As Range
Set ColA = Intersect(Range("A2:A65536"), ActiveSheet.UsedRange)
For Each cell In ColA
If cell <> "" Then
With cell.Offset
If .Offset(1, 1) = "" Then
.Offset(0, 2) = .Offset(0, 1)
ElseIf .Offset(1, 1) <> "" And .Offset(2, 1) = "" Then
.Offset(0, 2) = .Offset(0, 1) & " " & .Offset(1, 1)
ElseIf .Offset(1, 1) <> "" And .Offset(2, 1) <> "" Then
.Offset(0, 2) = .Offset(0, 1) & " " & .Offset(1, 1) & " " & .Offset(2, 1)
End If
End With
End If
Next
End Sub



Posted by Celia on October 08, 2000 4:53 PM

Follow-up


Jeff
The macro that was posted only works for data up to 4 rows.
The following should work for any number of rows per set.
Celia

Sub Concatenate_Description()
Dim ColA As Range, cell As Range, cell2 As Range, cell3 As Range
Set ColA = Intersect(Range("A2:A65536"), ActiveSheet.UsedRange)
For Each cell In ColA
Set cell2 = cell.Offset(0, 1)
Set cell3 = cell.Offset(0, 2)
If cell <> "" Then
Do Until cell2 = ""
If cell3 = "" Then
cell3 = cell2
Set cell2 = cell2.Offset(1, 0)
Else:
cell3 = cell3 & " " & cell2
Set cell2 = cell2.Offset(1, 0)
End If
Loop
End If
Next
End Sub