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

 

[Skyybot]

How are the Columns set up? Is the DIM 1 2 3 4 5 6 all in one cell, or is the DIM in Column1, 1 in Column2, 2 in Column3, etc.?

 

[panyagak]

How are the Columns set up? Is the DIM 1 2 3 4 5 6 all in one cell, or is the DIM in Column1, 1 in Column2, 2 in Column3, etc.?

DIM in Column1, 1 in Column2, 2 in
Column3, etc.?

Even in one Cell is ok, I can separate.

thanks

 

[Skyybot]

I need to know how the data is arranged so the code will work. Look at the examples and tell me how it is.

Book1
	A	B
1	DIM 1 2 3 4 5
Sheet1

Book1
	A	B	C	D	E	F
1	DIM	1	2	3	4	5
Sheet1

 

[panyagak]

I need to know how the data is arranged so the code will work. Look at the examples and tell me how it is.

Book1
	A	B
1	DIM 1 2 3 4 5
Sheet1

Book1
	A	B	C	D	E	F
1	DIM	1	2	3	4	5
Sheet1

Excel Sheet Sheet 1 is ok. In one Cell

thanks

 

[panyagak]

I need to know how the data is arranged so the code will work. Look at the examples and tell me how it is.

Book1
	A	B
1	DIM 1 2 3 4 5
Sheet1

Book1
	A	B	C	D	E	F
1	DIM	1	2	3	4	5
Sheet1

hi.

Either solution is ok for me

 

[kevin9999]

See if either of these works for you (both options given)

Sub In_One_Cell()
    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" Then
            s = s & " " & a(i, 1)
        Else
            b(j, 1) = s: j = j + 1: s = "DIM"
        End If
    Next i
    
    Range("A1").Resize(UBound(b, 1), 1).Value = b
End Sub

Sub In_Multi_Cells()
    Dim a, b, i As Long, j As Long, k As Long
    a = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 7)
    
    j = 1: k = 1
    b(j, k) = "DIM": k = k + 1
    For i = 2 To UBound(a, 1)
        If a(i, 1) <> "DIM" Then
            b(j, k) = a(i, 1)
            k = k + 1
        Else
            j = j + 1: k = 1
            b(j, k) = "DIM": k = k + 1
        End If
    Next i
    
    Range("A1").Resize(UBound(b, 1), 7).Value = b
End Sub

 

[panyagak]

See if either of these works for you (both options given)

Sub In_Multi_Cells()
    Dim a, b, i As Long, j As Long, k As Long
    a = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 7)
  
    j = 1: k = 1
    b(j, k) = "DIM": k = k + 1
    For i = 2 To UBound(a, 1)
        If a(i, 1) <> "DIM" Then
         [B] [B]  b(j, k) = a(i, 1)[/B][/B]
            k = k + 1
        Else
            j = j + 1: k = 1
            b(j, k) = "DIM": k = k + 1
        End If
    Next i
  
    Range("A1").Resize(UBound(b, 1), 7).Value = b
End Sub

On Running there is a Error 9, on Debugging the VBA Line in bold is highlighted

 

[kevin9999]

the VBA Line in bold is highlighted

Which line is that? (nothing was bold in your reply)

 

[panyagak]

Which line is that? (nothing was bold in your reply)

b(j, k) = a(i, 1) in the 2nd code

the 1st code has cleared all the column data

Either DIM 1 2 3 4 5 6 CAN BE in one cell, OR Separate columns, the easiest the better