Move selected column data to new rows

[colaboy]

I have the following sheet where columns H-M should be moved from columns to new rows to be able to use the data effectively in pivot tables.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Date	Variety	GH	Ghsub	Farm	Stems	LQ	35cm	40cm	50cm	60cm	70cm	80cm
2	01/08/2011	SAMBA PA TI	3		Lower	80	3900		10	70
3	01/08/2011	UPPER GREEN	0		Lower	30	1500			30
4	01/08/2011	HIGH AND EXOTIC	16		Lower	0	0
5	01/08/2011	MARIE CLAIRE	31		Lower	50	3000				50
6	01/08/2011	MARIE CLAIRE	32		Lower	140	6450	30	30	60	20
7	01/08/2011	MARIE CLAIRE	33		Lower	240	11200		150	40	30	20
8	01/08/2011	GOOD TIMES	3		Lower	0	0
9	01/08/2011	BURGUNDY	3		Lower	0	0
10	01/08/2011	BURGUNDY	16		Lower	170	10500			10	130	20	10
11	01/08/2011	SATISFACTION	16		Lower	20	1100			10	10
Gradeout

Excel 2010

I want to create something like this:

Excel Workbook
	A	B	C	D	E	F	G	H
1	Date	Variety	GH	Ghsub	Farm	Stems	LQ	Length
2	01/08/2011	SAMBA PA TI	3		Lower		0	35
3	01/08/2011	SAMBA PA TI	3		Lower	10	400	40
4	01/08/2011	SAMBA PA TI	3		Lower	70	3500	50
5	01/08/2011	SAMBA PA TI	3		Lower		0	60
6	01/08/2011	SAMBA PA TI	3		Lower		0	70
7	01/08/2011	SAMBA PA TI	3		Lower		0	80
8	01/08/2011	UPPER GREEN	0		Lower		0	35
9	01/08/2011	UPPER GREEN	0		Lower		0	40
10	01/08/2011	UPPER GREEN	0		Lower	30	1500	50
11	01/08/2011	UPPER GREEN	0		Lower		0	60
12	01/08/2011	UPPER GREEN	0		Lower		0	70
13	01/08/2011	UPPER GREEN	0		Lower		0	80
14	01/08/2011	HIGH AND EXOTIC	16		Lower		0	35
15	01/08/2011	HIGH AND EXOTIC	16		Lower		0	40
16	01/08/2011	HIGH AND EXOTIC	16		Lower		0	50
17	01/08/2011	HIGH AND EXOTIC	16		Lower		0	60
18	01/08/2011	HIGH AND EXOTIC	16		Lower		0	70
19	01/08/2011	HIGH AND EXOTIC	16		Lower		0	80
20	01/08/2011	MARIE CLAIRE	31		Lower		0	35
21	01/08/2011	MARIE CLAIRE	31		Lower		0	40
22	01/08/2011	MARIE CLAIRE	31		Lower		0	50
23	01/08/2011	MARIE CLAIRE	31		Lower	50	3000	60
24	01/08/2011	MARIE CLAIRE	31		Lower		0	70
25	01/08/2011	MARIE CLAIRE	31		Lower		0	80
Gradeout New

Excel 2010

I am sure this has been explained before but I cannot find anything suitable by searching.

I have data for several years and an option for removing zero value rows (in column "Stems") would help reduce the size of the sheet.

Is there a simple way to make the transformation or does VBA have to be used?

Any help in getting started is most welcome (I am stuck).

PS. I would probably be better off working in Access but I am not very familiar with it nor are the clerks inputting the data.

 

[hiker95]

colaboy,


Welcome to the MrExcel forum.


Sample raw data on worksheet Gradeout:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Date	Variety	GH	Ghsub	Farm	Stems	LQ	35cm	40cm	50cm	60cm	70cm	80cm
2	1/8/2011	SAMBA PA TI	3		Lower	80	3900		10	70
3	1/8/2011	UPPER GREEN	0		Lower	30	1500			30
4	1/8/2011	HIGH AND EXOTIC	16		Lower	0	0
5	1/8/2011	MARIE CLAIRE	31		Lower	50	3000				50
6	1/8/2011	MARIE CLAIRE	32		Lower	140	6450	30	30	60	20
7	1/8/2011	MARIE CLAIRE	33		Lower	240	11200		150	40	30	20
8	1/8/2011	GOOD TIMES	3		Lower	0	0
9	1/8/2011	BURGUNDY	3		Lower	0	0
10	1/8/2011	BURGUNDY	16		Lower	170	10500			10	130	20	10
11	1/8/2011	SATISFACTION	16		Lower	20	1100			10	10
12
Gradeout

After the macro in a new or cleared worksheet Gradeout New:

Excel Workbook
	A	B	C	D	E	F	G	H
1	Date	Variety	GH	Ghsub	Farm	Stems	LQ	Length
2	1/8/2011	SAMBA PA TI	3		Lower		0	35
3	1/8/2011	SAMBA PA TI	3		Lower	10	400	40
4	1/8/2011	SAMBA PA TI	3		Lower	70	3500	50
5	1/8/2011	SAMBA PA TI	3		Lower		0	60
6	1/8/2011	SAMBA PA TI	3		Lower		0	70
7	1/8/2011	SAMBA PA TI	3		Lower		0	80
8	1/8/2011	UPPER GREEN	0		Lower		0	35
9	1/8/2011	UPPER GREEN	0		Lower		0	40
10	1/8/2011	UPPER GREEN	0		Lower	30	1500	50
11	1/8/2011	UPPER GREEN	0		Lower		0	60
12	1/8/2011	UPPER GREEN	0		Lower		0	70
13	1/8/2011	UPPER GREEN	0		Lower		0	80
14	1/8/2011	HIGH AND EXOTIC	16		Lower		0	35
15	1/8/2011	HIGH AND EXOTIC	16		Lower		0	40
16	1/8/2011	HIGH AND EXOTIC	16		Lower		0	50
17	1/8/2011	HIGH AND EXOTIC	16		Lower		0	60
18	1/8/2011	HIGH AND EXOTIC	16		Lower		0	70
19	1/8/2011	HIGH AND EXOTIC	16		Lower		0	80
20	1/8/2011	MARIE CLAIRE	31		Lower		0	35
21	1/8/2011	MARIE CLAIRE	31		Lower		0	40
22	1/8/2011	MARIE CLAIRE	31		Lower		0	50
23	1/8/2011	MARIE CLAIRE	31		Lower	50	3000	60
24	1/8/2011	MARIE CLAIRE	31		Lower		0	70
25	1/8/2011	MARIE CLAIRE	31		Lower		0	80
26	1/8/2011	MARIE CLAIRE	32		Lower	30	1050	35
27	1/8/2011	MARIE CLAIRE	32		Lower	30	1200	40
28	1/8/2011	MARIE CLAIRE	32		Lower	60	3000	50
29	1/8/2011	MARIE CLAIRE	32		Lower	20	1200	60
30	1/8/2011	MARIE CLAIRE	32		Lower		0	70
31	1/8/2011	MARIE CLAIRE	32		Lower		0	80
32	1/8/2011	MARIE CLAIRE	33		Lower		0	35
33	1/8/2011	MARIE CLAIRE	33		Lower	150	6000	40
34	1/8/2011	MARIE CLAIRE	33		Lower	40	2000	50
35	1/8/2011	MARIE CLAIRE	33		Lower	30	1800	60
36	1/8/2011	MARIE CLAIRE	33		Lower	20	1400	70
37	1/8/2011	MARIE CLAIRE	33		Lower		0	80
38	1/8/2011	GOOD TIMES	3		Lower		0	35
39	1/8/2011	GOOD TIMES	3		Lower		0	40
40	1/8/2011	GOOD TIMES	3		Lower		0	50
41	1/8/2011	GOOD TIMES	3		Lower		0	60
42	1/8/2011	GOOD TIMES	3		Lower		0	70
43	1/8/2011	GOOD TIMES	3		Lower		0	80
44	1/8/2011	BURGUNDY	3		Lower		0	35
45	1/8/2011	BURGUNDY	3		Lower		0	40
46	1/8/2011	BURGUNDY	3		Lower		0	50
47	1/8/2011	BURGUNDY	3		Lower		0	60
48	1/8/2011	BURGUNDY	3		Lower		0	70
49	1/8/2011	BURGUNDY	3		Lower		0	80
50	1/8/2011	BURGUNDY	16		Lower		0	35
51	1/8/2011	BURGUNDY	16		Lower		0	40
52	1/8/2011	BURGUNDY	16		Lower	10	500	50
53	1/8/2011	BURGUNDY	16		Lower	130	7800	60
54	1/8/2011	BURGUNDY	16		Lower	20	1400	70
55	1/8/2011	BURGUNDY	16		Lower	10	800	80
56	1/8/2011	SATISFACTION	16		Lower		0	35
57	1/8/2011	SATISFACTION	16		Lower		0	40
58	1/8/2011	SATISFACTION	16		Lower	10	500	50
59	1/8/2011	SATISFACTION	16		Lower	10	600	60
60	1/8/2011	SATISFACTION	16		Lower		0	70
61	1/8/2011	SATISFACTION	16		Lower		0	80
62
Gradeout New

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Option Base 1
Sub ReorgData()
' hiker95, 08/21/2011
' http://www.mrexcel.com/forum/showthread.php?t=573337
Dim wG As Worksheet, wN As Worksheet
Dim LR As Long, LC As Long, r As Long, c As Long, n As Long, NR As Long
Dim CM(), nn As Long
Application.ScreenUpdating = False
Set wG = Worksheets("Gradeout")
LR = wG.Cells(Rows.Count, 1).End(xlUp).Row
LC = wG.Cells(1, Columns.Count).End(xlToLeft).Column
ReDim CM(1 To LC - 8 + 1)
n = 0
For c = 8 To LC Step 1
  n = n + 1
  CM(n) = Replace(wG.Cells(1, c), "cm", "")
Next c
If Not Evaluate("ISREF('Gradeout New'!A1)") Then Worksheets.Add(After:=wG).Name = "Gradeout New"
Set wN = Worksheets("Gradeout New")
wN.UsedRange.Clear
wG.Range("A1:G1").Copy wN.Range("A1:G1")
With wN.Range("H1")
  .Value = "Length"
  .Font.Bold = True
End With
n = LC - 8 + 1
For r = 2 To LR Step 1
  NR = wN.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
  wN.Range("A" & NR).Resize(n, 5).Value = wG.Range("A" & r).Resize(, 5).Value
  wN.Range("H" & NR).Resize(UBound(CM)).Value = Application.Transpose(CM)
  nn = NR
  For c = 8 To LC Step 1
    If wG.Cells(r, c) = "" Then         'And sw = 0 Then
      wN.Cells(nn, 7) = 0
    Else
      wN.Cells(nn, 6).Value = wG.Cells(r, c).Value
      wN.Cells(nn, 7).Value = wG.Cells(r, c).Value * CM(c - 7)
    End If
    nn = nn + 1
  Next c
Next r
Erase CM
wN.UsedRange.Columns.AutoFit
wN.Activate
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

 

[colaboy]

It works beautifully! (not fast but a lot faster than copy/paste)

Thanks so much hiker95!

I hope to be able to decipher the code soon

 

[hiker95]

colaboy,

You are very welcome.

Glad I could help.

Thanks for the feedback.

It works beautifully! (not fast but a lot faster than copy/paste)

Does worksheet Gradeout only have data in columns A thru M?

If so, let me try using arrays (which I am learning) that should really speed things up.

 

[hiker95]

colaboy,


I just tested the old and the new macro with 10,801 rows of raw data.

The old macro took 5 seconds, the new macro (with arrays working in memory) took 0.9 seconds.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Option Base 1
Sub ReorgDataV2()
' hiker95, 08/22/2011
' http://www.mrexcel.com/forum/showthread.php?t=573337
Dim wG As Worksheet, wN As Worksheet
Dim LR As Long, LC As Long, r As Long, c As Long, nr As Long, nn As Long
Dim CM(), G(), N()
Application.ScreenUpdating = False
Set wG = Worksheets("Gradeout")
LR = wG.Cells(Rows.Count, 1).End(xlUp).Row
LC = wG.Cells(1, Columns.Count).End(xlToLeft).Column
G = wG.Range("A1:M" & LR)
ReDim CM(1 To 6)
nn = 0
For c = 8 To 13 Step 1
  nn = nn + 1
  CM(nn) = Replace(G(1, c), "cm", "")
Next c
ReDim N(1 To ((UBound(G) - 1) * 6) + 1, 1 To 8)
For c = 1 To 7
  N(1, c) = G(1, c)
Next c
N(1, 8) = "Length"
nr = 2
For r = 2 To UBound(G)
  For nn = nr To nr + 5
    For c = 1 To 5
      N(nn, c) = G(r, c)
    Next c
  Next nn
  c = 0
  For nn = nr To nr + 5
    c = c + 1
    N(nn, 8) = CM(c)
  Next nn
  nn = nr
  For c = 8 To 13
    If G(r, c) = "" Then
      N(nn, 7) = 0
    Else
      N(nn, 6) = G(r, c)
      N(nn, 7) = G(r, c) * CM(c - 7)
    End If
    nn = nn + 1
  Next c
  nr = nr + 6
Next r
If Not Evaluate("ISREF('Gradeout New'!A1)") Then Worksheets.Add(After:=wG).Name = "Gradeout New"
Set wN = Worksheets("Gradeout New")
wN.UsedRange.Clear
wN.Range("A1").Resize(UBound(N), 8) = N
wN.UsedRange.Columns.AutoFit
wN.Activate
Erase CM
Erase G
Erase N
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the ReorgDataV2 macro.

 

[colaboy]

Excellent hiker95!

The first version took more than 5 minutes to process 3152 rows of data on my system. (i7, Q740 @ 1.73GHz, 6GB RAM, 64 bit, 32-bit Office Pro)

V2 takes about one second!!!

Thanks again for coming to my rescue.

What could be the reason for the slowness of V1 on my system? Excel goes do non-responding "white screen" during running V1 while CPU stays at 1% for excel.exe.

 

[hiker95]

colaboy,

Glad I could help.

You are very welcome.

Thanks for the feedback.