Turning columns into blocks of rows

[tonkerthomas]

Good afternoon everybody.

I have a very large spreadsheet which contains around 2000 rows, the first six columns of which are master data. Thereafter, there is a number of six-column blocks that contain "sets" of transactional data. All rows have at least one six-column block, some have more, up to a maximum of 87 blocks (meaning 6*87 columns). Beyond the point at which any given row "runs out" of data, it's completely empty.

What I need to do is this: for any row which has more than one set of transactional data (i.e. any row with data in column M or beyond), I need to cut the data out, in six-column blocks, and paste that into new rows beneath the first set of transactional data.

So, we'd go from this:

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

1

M1

M2

M3

M4

M5

M6

T11

T12

T13

T14

T15

T16

T21

T22

T23

T24

T25

T26

T31

T32

T33

T34

T35

T36

2

M1

M2

M3

M4

M5

M6

T11

T12

T13

T14

T15

T16

3

M1

M2

M3

M4

M5

M6

T11

T12

T13

T14

T15

T16

T21

T22

T23

T24

T25

T26

<tbody>
</tbody>

... to this:

A

B

C

D

E

F

G

H

I

J

K

L

1

M1

M2

M3

M4

M5

M6

T11

T12

T13

T14

T15

T16

2

T21

T22

T23

T24

T25

T26

3

T31

T32

T33

T34

T35

T36

4

M1

M2

M3

M4

M5

M6

T11

T12

T13

T14

T15

T16

5

M1

M2

M3

M4

M5

M6

T11

T12

T13

T14

T15

T16

6

T21

T22

T23

T24

T25

T26

<tbody>
</tbody>

As you can see, the master data doesn't need to be copied down into the new rows, and once the transactional data "runs out" for any given line, I can stop inserting rows and cutting the data into them (so there won't be any empty rows in the final data).

Can anybody help me? I suspect this isn't terribly hard, but even though I think I understand the logic required I can't convert into into a macro.

My thanks, as ever, to anybody who has taken the time and trouble to read this, and in advance to anybody who has a crack at it.

Cheers

Jeff

 

[MickG]

Try this for results on sheet2 Starting "A1".

[COLOR="Navy"]Sub[/COLOR] MG13Feb00
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] St [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = ActiveSheet.Range("A1").CurrentRegion

ReDim nray(1 To UBound(Ray, 1) * 100, 1 To 12)
c = 1
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
St = 6
[COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray, 2)
    [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(n, Ac)) [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Ac > 6 [COLOR="Navy"]Then[/COLOR] num = num + 1
        [COLOR="Navy"]If[/COLOR] Ac <= 12 [COLOR="Navy"]Then[/COLOR]
            nray(c, Ac) = Ray(n, Ac)
        [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Ac > 12 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] St Mod 6 = 0 [COLOR="Navy"]Then[/COLOR] c = c + 1: St = 6
            St = St + 1
            nray(c, St) = Ray(n, Ac)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
 
 [COLOR="Navy"]Next[/COLOR] Ac
c = c + 1
[COLOR="Navy"]Next[/COLOR] n
Sheets("Sheet2").Range("A1").Resize(c, 12) = nray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[tonkerthomas]

Ah, thank you, Mick. That's very, very nearly it, I reckon... it seems as though it's consolidating "blocks", though - so for instance, if the third cell of a block is blank, it's essentially deleting that cell in transit and I end up with five cells in the block rather than six. Can that be? And can we make it so that it keeps blank cells as valid data points? Have I explained that clearly?

Thanks a million for your help,

Jeff

 

[tonkerthomas]

You're ending up with this:

A

B

C

D

E

F

G

H

I

J

K

L

1

M1

M2

M3

M4

M5

M6

T11

T12

T13

T14

T15

T16

2

T21

T23

T24

T25

T26

3

T31

T32

T33

T34

T35

T36

<tbody>
</tbody>

... where T22 in the source data is a blank cell.

 

[MickG]

When I run the code on the first line with "T22" as an empty cell I Get this, not quite the same as your previous post . From columns 7, the three lines are shown as continuous (No Gaps)???:-


I'm not sure why that should be , But here is an alternative to show Blank cell as Blank cells:-

[COLOR=navy]Sub[/COLOR] MG13Feb49
[COLOR=navy]Dim[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] St [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] num [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] t
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Lst [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
c = 1
ReDim nray(1 To Rng.Count * 100, 1 To 12)
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
 Lst = Cells(Dn.Row, Columns.Count).End(xlToLeft).Column
    [COLOR=navy]For[/COLOR] Ac = 1 To Lst
        [COLOR=navy]If[/COLOR] Ac <= 12 [COLOR=navy]Then[/COLOR]
            nray(c, Ac) = Rng(Dn.Row, Ac)
        [COLOR=navy]End[/COLOR] If
        
        [COLOR=navy]If[/COLOR] Ac > 12 [COLOR=navy]Then[/COLOR]
            [COLOR=navy]If[/COLOR] St Mod 6 = 0 [COLOR=navy]Then[/COLOR] c = c + 1: St = 6
            St = St + 1
            nray(c, St) = Rng(Dn.Row, Ac)
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Ac
c = c + 1
[COLOR=navy]Next[/COLOR] Dn
Sheets("Sheet2").Range("A1").Resize(c, 12) = nray
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[MickG]

When I run the code, this is how the first line looks, for me:-

M1	M2	M3	M4	M5	M6	T11	T12	T13	T14	T15	T16
						T21	T23	T24	T25	T26	T31
						T32	T33	T34	T35	T36

<colgroup><col width="64" span="12" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[tonkerthomas]

That's weird... for the first couple of hundred rows of the source data, it works perfectly, and then on row 206, it picks up the first cell of the first data block and then skips the next five, even though they're not blank. Thereafter the same thing happens regularly - dropping three, four, five data points at a time. I don't understand your code enough to figure out what might be happening. I can't see any reason that it works in most places and not in others - there doesn't seem to be anything different about the data which causes it to happen. Any ideas?

EDIT: the "first couple of hundred rows" thing is a red herring, because if I delete the first couple of hundred rows from the data and re-run, the same issues occur in the same place.

 

[MickG]

Can you send the lines it fails on .!!

 

[tonkerthomas]

Here's two source lines and two results: the first (Master1) fails, and the second (Master2) works perfectly. Does that help? Sorry, I'm not having much joy formatting this stuff after I've pasted it in...

12030	Master1	19-4-2011	18-4-2020	18-4-2020		#1018560	213.144,98	EUR	19-4-2011	18-4-2020	Annual	#1018563	4.900,00	EUR	19-4-2011	18-4-2020	Annual	#1018645	209.530,00	EUR	1-7-2010	18-4-2011	n/a	#2650322	2.000,00	EUR	19-4-2011	18-4-2020	Annual	#3185617	98.786,96	EUR	1-4-2002	30-6-2010	Annual
12051	Master2	1-10-2016	31-12-2018	31-12-2018		#1016895	58.050,00	EUR	1-10-2016	31-12-2018	Annual	#1017023	38.700,00	EUR	1-7-2016	30-9-2016	Annual	#2944974	6.450,00	EUR	1-4-2016	30-6-2016	n/a	#2975916	38.700,00	EUR	1-7-2016	30-9-2016	Annual
12030	Master1	19-4-2011	18-4-2020	18-4-2020		#1018560	213.144,98	EUR	19-4-2011	18-4-2020	Annual
						#1018563	4.900,00	EUR	19-4-2011	18-4-2020	Annual
						#1018645	209.530,00	EUR	1-7-2010	18-4-2011	n/a
						#2650322	2.000,00	EUR	19-4-2011	18-4-2020	Annual
						#3185617	98.786,96	EUR	1-4-2002	30-6-2010	Annual
12051	Master2	1-10-2016	12/31/2018	31-12-2018		#1016895	#1017023	38700	EUR	1-7-2016	9/30/2016
						Annual	#2944974	6450	EUR	1-4-2016	6/30/2016
						n/a	#2975916	38700	EUR	1-7-2016	9/30/2016
						Annual

<tbody>
</tbody>

 

[tonkerthomas]

I posted this on another Excel Board and they came up with this:

Sub RearrangeData()
Dim x, y(), z, i As Long, ii As Long, iii As Long, iv As Long, v As Long

With ActiveSheet.Cells(1).CurrentRegion
x = .Value2
For i = 1 To UBound(x, 1)
iii = iii + 1: ReDim Preserve y(1 To 12, 1 To iii)
For ii = 1 To 12
y(ii, iii) = x(i, ii)
Next
iv = 13
Do Until x(i, iv) = vbNullString
v = 6
iii = iii + 1: ReDim Preserve y(1 To 12, 1 To iii)
For ii = iv To iv + 5
v = v + 1
y(v, iii) = x(i, ii)
Next
iv = iv + 6
If iv >= UBound(x, 2) Then Exit Do
Loop
Next
If iii > .Parent.Rows.Count Then
MsgBox "There are insufficient rows on the worksheet to rearrange the data.", 16, "Data too large"
Exit Sub
End If
ReDim z(1 To iii, 1 To 12)
For i = 1 To iii
For ii = 1 To 12
z(i, ii) = y(ii, i)
Next
Next
.Clear
.Parent.[a1].Resize(iii, 12) = z
End With

End Sub

It works perfectly. The funny thing is, I have two source files, one of which works perfectly with your code, and the other not - so it MUST be something to do with the data itself. Whatever that is, though, the above code avoids the problem.

Thank you ever so much for your help, Mick. I don't generally crowdsource my help, but I was in a bit of a hurry with this so I needed to put more than one line in the water - I hope you're not offended, and if you are, I'm genuinely sorry. I hope the answer is as enlightening for you as it was for me.

Cheers

Jeff