vba at each change

[panyagak]

Hi all.

Microsoft 2010 in use

This is simplified data (Range to last cell on column A) arranged vertically for ease of presentation.

i would like to Transform the arrangement using vba possibly using "At each change in DIM" convert to this horizontally To This:

DIM 1 2 3 4 5 6
DIM 7 8 9 10 11 12
etc up to last cell.

My data as simplified:
DIM
1
2
3
4
5
6
DIM
7
8
9
10
11
12
DIM
13
14
15
16
17
18
DIM
.
.
.

Thanks as I prepare to sleep

Regards
Patrick

 

[kevin9999]

OK, it's difficult to see where your data actually begins in your original post. To demonstrate, starting with the following assumed layout of your data:

Book1
	A
1	DIM
2	1
3	2
4	3
5	4
6	5
7	6
8	DIM
9	7
10	8
11	9
12	10
13	11
14	12
15	DIM
16	13
17	14
18	15
19	16
20	17
21	18
22	DIM
Sheet1

The first option returned this:

Book1
	A
1	DIM 1 2 3 4 5 6
2	DIM 7 8 9 10 11 12
3	DIM 13 14 15 16 17 18
4
Sheet1

The second option returned this:

Book1
	A	B	C	D	E	F	G
1	DIM	1	2	3	4	5	6
2	DIM	7	8	9	10	11	12
3	DIM	13	14	15	16	17	18
4	DIM
5
Sheet1

Could you provide a copy of your actual worksheet using the XL2BB add in, or alternatively share your file via Google Drive, Dropbox or similar file sharing platform?

 

[panyagak]

Y

OK, it's difficult to see where your data actually begins in your original post. To demonstrate, starting with the following assumed layout of your data:

Book1
	A
1	DIM
2	1
3	2
4	3
5	4
6	5
7	6
8	DIM
9	7
10	8
11	9
12	10
13	11
14	12
15	DIM
16	13
17	14
18	15
19	16
20	17
21	18
22	DIM
Sheet1

The first option returned this:

Book1
	A
1	DIM 1 2 3 4 5 6
2	DIM 7 8 9 10 11 12
3	DIM 13 14 15 16 17 18
4
Sheet1

The second option returned this:

Book1
	A	B	C	D	E	F	G
1	DIM	1	2	3	4	5	6
2	DIM	7	8	9	10	11	12
3	DIM	13	14	15	16	17	18
4	DIM
5
Sheet1

Could you provide a copy of your actual worksheet using the XL2BB add in, or alternatively share your file via Google Drive, Dropbox or similar file sharing platform

OK, it's difficult to see where your data actually begins in your original post. To demonstrate, starting with the following assumed layout of your data:

Book1
	A
1	DIM
2	1
3	2
4	3
5	4
6	5
7	6
8	DIM
9	7
10	8
11	9
12	10
13	11
14	12
15	DIM
16	13
17	14
18	15
19	16
20	17
21	18
22	DIM
Sheet1

The first option returned this:

Book1
	A
1	DIM 1 2 3 4 5 6
2	DIM 7 8 9 10 11 12
3	DIM 13 14 15 16 17 18
4
Sheet1

The second option returned this:

Book1
	A	B	C	D	E	F	G
1	DIM	1	2	3	4	5	6
2	DIM	7	8	9	10	11	12
3	DIM	13	14	15	16	17	18
4	DIM
5
Sheet1

Could you provide a copy of your actual worksheet using the XL2BB add in, or alternatively share your file via Google Drive, Dropbox or similar file sharing platform?

You got it CORRECTLY!! A1 downwards THOUGH I cant see the Formulas!!!!

 

[panyagak]

Y



You got it CORRECTLY!! A1 downwards THOUGH I cant see the Formulas!!!!

thank you so much kevin9999

 

[panyagak]

thank you so much kevin9999

kevin9999.

Kevin9999.

effect on a bigger Range

suppose there are uneven breaks apart from the fine data I presented before the next DIM, Code 2 seems to return "Run time Error 9" "Subscript out of Range" - on this line "b(j, k) = a(i, 1)" when my current Range is A1:A1902.

one DIM to the next DIM is not uniform as my simple data demonstrated, it varies

 

[kevin9999]

Could you please share your actual data via Google Drive, Dropbox or similar file sharing platform? Only need column A.

 

[kevin9999]

Here's a couple of updated modules for you to try:

Sub In_One_Cell_V2()
    Dim a, b, i As Long, j As Long, s As String
    a = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    
    s = "DIM": j = 1
    For i = 2 To UBound(a, 1)
        If a(i, 1) <> "DIM" And a(i, 1) <> "" Then
            s = s & " " & a(i, 1)
            b(j, 1) = s
        ElseIf a(i, 1) = "DIM" Then
            b(j, 1) = s: j = j + 1: s = "DIM"
        End If
    Next i
    Range("A1").Resize(UBound(b, 1), 1).Value = b
    Range("A:A").EntireColumn.AutoFit
End Sub

Sub In_Multi_Cells_V2()
    Dim a, b, i As Long, j As Long, s As String
    a = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    
    s = "DIM": j = 1
    For i = 2 To UBound(a, 1)
        If a(i, 1) <> "DIM" And a(i, 1) <> "" Then
            s = s & " " & a(i, 1)
            b(j, 1) = s
        ElseIf a(i, 1) = "DIM" Then
            b(j, 1) = s: j = j + 1: s = "DIM"
        End If
    Next i
    Range("A1").Resize(UBound(b, 1), 1).Value = b
    With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        Application.DisplayAlerts = False
        .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Space:=True
        Application.DisplayAlerts = True
    End With
End Sub