addmittedly not the prettiest, but its been a long day, try this out

Sub main()
Dim myRow As Long
Dim myCol As Long
Dim myString As String
Dim startRow As Long
myCol = 1
myRow = 1
startRow = 1
Do Until Cells(myRow, 1) = ""
Do Until Cells(myRow, myCol) = ""
myString = myString & Cells(myRow, myCol)
myRow = myRow + 1
myCol = myCol + 1
Loop
myCol = 1

Cells(startRow, 1) = myString
startRow = myRow
myString = ""
If Cells(myRow, 1) = "" Then Exit Sub
Loop
End Sub

--
-John
Please rate when your question is answered to help us and others know what
is helpful.


"Danny" wrote:

Hi all
I have a spreadsheet which has a list of data that was previously
grouped via the group and ungroup excel function.
I have removed this and want to concatenate data within the old
groups. As an example the data is like so.....

A
B
C
D
E
F
G
H
I
J
K

What i want to achieve is to group in cell A1 - A,B,C and then in A2 -
D,E,F and then in A3 - G,H,I,J,K

My code so far is below which allows me to group the first level but i
need to to take into account the second example of G,H,I,J,K which
covers more than two or three concatenations.

Can anyone help
Thanks very much


=====================
Dim fCell As Excel.Range
Dim sCell As Excel.Range

i = 0
r = 0

With ThisWorkbook.Sheets(1).Cells
Set fCell = .Range("A6")
Set sCell = .Range("C6")

With ThisWorkbook.Sheets(1).UsedRange
lLastRow = .Row + .Rows.Count - 1
End With

Do Until i = lLastRow
If iPrev = fCell.Offset(i, 0).Value Then
If sCell.Offset(i + 1, 0).Value < "" Then
Do While fCell.Offset(i, 0).Value
= ""
If iDesc = sCell.Offset(i,
0).Value Then
If sCell.Offset(r,
2).Value < "" Then
Do Until
sCell.Offset(r, 2).Value = ""
myval =
sCell.Offset(r, 2).Value
r = r + 1
i = i + 1
Loop
End If
Else

End If
iDesc = sCell.Offset(i, 0).Value
i = i + 1
r = r + 1
Loop
End If

Else

End If
iPrev = fCell.Offset(i, 0).Value
r = r + 1
Loop

End With

End Sub
============================