ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Group and ungroup (https://www.excelbanter.com/excel-programming/400845-group-ungroup.html)

Danny[_12_]

Group and ungroup
 
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
============================


John Bundy

Group and ungroup
 
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
============================



Danny[_12_]

Group and ungroup
 
On 8 Nov, 21:21, John Bundy (remove) wrote:
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
============================- Hide quoted text -


- Show quoted text -




----------
Hi John
Thanks very much for that, i have tweaked it slightly and fitted it in
with what i had done previously but one other thing is that i have a
more complex example of the group and outline.

A
B
C
D
E
F
G
H
I
J
K
L
M

Therefore i would need to concatenate the A,B,C and A,B,D etc and then
A,G,H etc
How would it be possible to always keep the A whilst moving down and
looping to the next layers.
Thanks again in advance



All times are GMT +1. The time now is 04:04 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com