Macro to Transpose Rows to Columns

[drew1230]

Hey all,

I un-versed in VBA or any type of coding, for that matter, but it looks like formulas won't for what I'm attempting to do. I'm trying to transpose a variable number of cells in a row into columns right beneath the first column. I've already pre-inserted the required number of rows beneath each of the rows I'm trying to transpose.
I'm actually working with columns O to W (8 columns total)

I'm trying to get from...

a	b	c
1	2
aa	bb	cc	dd

<tbody>
</tbody>

to...

a	b	c
b
c
1	2
2
aa	bb	cc	dd
bb
cc
dd

<tbody>
</tbody>

Gotta do this for about 5,000 rows so any help would be appreciated! I can't imagine how many days this would take to finish manually.

-Drew

 

[hiker95]

apalomino,

Welcome to the MrExcel forum.

Here is a macro solution for you to consider that is based on the structure of your displayed flat text raw data in the active worksheet, and, will adjust to the number of raw data rows, and, columns.

Sample raw data in the active worksheet:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	category	rate description	Rate	Each	Rent	EOW	2x	3x	monthly	Daily	Loss	DS	NOG	Lease
2	Black Apron	Each		0	1	0	0	2	0	0	11	0	0	4
3		rent
4		EOW
5		2X
6		3X
7		Monthly
8		Daily
9		Loss
10		DS
11		NOG
12		Lease
13	Blue Apron	Each		0.7	0		0	0	1	0.9	12	5	0	0
14		Rent
15		EOW
16		2X
17		3X
18		Monthly
19		Daily
20		Loss
21		DS
22		NOG
23		Lease
24
Sheet1

And, after the macro:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	category	rate description	Rate	Each	Rent	EOW	2x	3x	monthly	Daily	Loss	DS	NOG	Lease
2	Black Apron	Each	0	0	1	0	0	2	0	0	11	0	0	4
3		rent	1
4		EOW	0
5		2X	0
6		3X	2
7		Monthly	0
8		Daily	0
9		Loss	11
10		DS	0
11		NOG	0
12		Lease	4
13	Blue Apron	Each	0.7	0.7	0		0	0	1	0.9	12	5	0	0
14		Rent	0
15		EOW
16		2X	0
17		3X	0
18		Monthly	1
19		Daily	0.9
20		Loss	12
21		DS	5
22		NOG	0
23		Lease	0
24
Sheet1

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
2. Open your NEW 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
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReorgData()
' hiker95, 06/29/2016, ME935668
Dim Area As Range, sr As Long, lc As Long
Application.ScreenUpdating = False
With ActiveSheet
  lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
  For Each Area In .Range("D2", .Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
    With Area
      sr = .Row
      Range("C" & sr).Resize(lc - 3).Value = Application.Transpose(Range(Cells(sr, 4), Cells(sr, lc)).Value)
    End With
  Next Area
End With
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgData macro.

 

[apalomino]

This unfortunately did not work. It pasted the column headers from E to N into C2 to C11.

 

[hiker95]

This unfortunately did not work. It pasted the column headers from E to N into C2 to C11.

apalomino,

Are my screenshots in my reply #11 not correct?

If my screenshots are not correct, then can we see your actual screenshots of the raw data (not flat text displays), and, what the results should look like?


See reply #2 at the next link, if you want to show small screenshots, of the raw data, and, what the results should look like.

http://www.mrexcel.com/forum/about-board/508133-attachments.html#post2507729


Or, you can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com

If you are not able to provide screenshots, then:

You can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com

 

[drew1230]

drew1230,

Have you even tried my macro in my reply #4?

Hiker95, sorry I didn't see that you had posted back then, but I'm grateful that you did. I revisited this thread because I had another use case where your code was exactly what I needed. It worked wonderfully! Thank you!

I just had to adjust a "Cells(r + 1, 15).Resize..." to "Cells(r + 1, 16).Resize..." in order to get the transposed values in the right column.

 

[hiker95]

Hiker95, sorry I didn't see that you had posted back then, but I'm grateful that you did. I revisited this thread because I had another use case where your code was exactly what I needed. It worked wonderfully! Thank you!

I just had to adjust a "Cells(r + 1, 15).Resize..." to "Cells(r + 1, 16).Resize..." in order to get the transposed values in the right column.

drew1230,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[Rick Rothstein]

Sub ReorgData()
' hiker95, 06/29/2016, ME935668
Dim Area As Range, sr As Long, lc As Long
Application.ScreenUpdating = False
With ActiveSheet
  lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
  For Each Area In .Range("D2", .Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
    With Area
      sr = .Row
      Range("C" & sr).Resize(lc - 3).Value = Application.Transpose(Range(Cells(sr, 4), Cells(sr, lc)).Value)
    End With
  Next Area
End With
Application.ScreenUpdating = True
End Sub

Assuming the number of horizontal labels (Row 1) equals the number of vertical labels (Column B) for each Category listed in Column A, then here is another way to write your macro...

[table="width: 500"]
[tr]
	[td]Sub ReorgData_V3()
  Dim Ar As Range
  Application.ScreenUpdating = False
  For Each Ar In Range("A2:A" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlBlanks).Areas
    Ar(1).Offset(-1, 2).Resize(Ar.Count + 1) = Application.Transpose(Ar(1).Offset(-1, 3).Resize(, Ar.Count + 1))
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[drew1230]

Hi!


It’s been some time since last time and my spreadsheet’s changed a bit. I attempted to figure this out on my own for a few hours by tinkering with the previous code, but to no avail. It’d be great if can get some help.


How can I go from:

	A	B	C	D	E	F	G	H	I	J
1	x	a	b	c	d	e	f	g	h	i
2	y	1	2	3	4	5	6
3	z	aa	bb	cc	dd

<tbody>
</tbody>

To:

	A	B	C	D	E	F	G	H	I	J
1	x	a	b	c	d	e	f	g	h	i
2		b
3		c
4		d
5		e
6		f
7		g
8		h
9		i
10	y	1	2	3	4	5	6
11		2
12		3
13		4
14		5
15		6
16	z	aa	bb	cc	dd
17		bb
18		cc
19		dd

<tbody>
</tbody>

?

In this case, the cells being transposed has not been pre-inserted into rows, and the number of cells from B on is indefinite.

Thanks your able to help!

 

[hiker95]

drew1230,

Here is a new macro solution for you to consider that is based on your latest flat text displays, that uses two arrays in memory.

With your raw data in the active worksheet in range A1:J3, the results will overwrite the raw data, and, will be written in range A1:J19.

Try the following:

Sub ReorganizeData()
' hiker95, 12/11/2017, ME935668
Application.ScreenUpdating = False
Dim a As Variant, r As Long, c As Long, cc As Long, lr As Long, lc As Long, n As Long
Dim o As Variant, j As Long
With ActiveSheet
  lr = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  n = Application.CountA(.Range(.Cells(1, 1), .Cells(lr, lc))) - lr
  ReDim o(1 To n, 1 To lc)
  For r = 1 To lr
    j = j + 1
    For c = 1 To lc
      o(j, c) = a(r, c)
    Next c
    For cc = 3 To lc
      If Not a(r, cc) = vbEmpty Then
        j = j + 1: o(j, 2) = a(r, cc)
      End If
    Next cc
  Next r
  .Range(.Cells(1, 1), .Cells(lr, lc)).ClearContents
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

 

[drew1230]

<style type="text/css"> p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; line-height: 16.0px; font: 13.0px Verdana; color: #222222; -webkit-text-stroke: #222222; background-color: #ffffff} p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; line-height: 16.0px; font: 13.0px Verdana; color: #222222; -webkit-text-stroke: #222222; min-height: 16.0px} p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; line-height: 16.0px; font: 13.0px Verdana; color: #222222; -webkit-text-stroke: #222222; background-color: #ffffff; min-height: 16.0px} p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; line-height: 12.0px; font: 12.0px Courier; color: #333333; -webkit-text-stroke: #222222; background-color: #f2f6f8} span.s1 {font-kerning: none} </style>Hi Hiker95,


Thanks for taking the time. My spreadsheet actually has around 5000 rows and the columns to be transposed starts at column C and on indefinitely. Sorry I wasn't clear!


The macro that you gave me a little over a year ago looks like should be able to accomplish this with a few tweaks, but I haven’t been able to figure it out. Here it is below:


Sub TransposeRowsToColumn()
' hiker95, 04/18/2016, ME935668
Dim r As Long, lr As Long, lc As Long, n As Long
Application.ScreenUpdating = False
With ActiveSheet
lr = .Cells(Rows.Count, "O").End(xlUp).Row
For r = lr To 1 Step -1
lc = .Cells(r, Columns.Count).End(xlToLeft).Column
n = lc - 15
.Rows(r + 1).Resize.Insert
.Cells(r + 1, 15).Resize.Value = Application.Transpose(.Range(.Cells(r, 16), .Cells(r, lc)).Value)
Next r
End With
Application.ScreenUpdating = True
End Sub


<style type="text/css"> p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; line-height: 16.0px; font: 13.0px Verdana; color: #222222; -webkit-text-stroke: #222222} p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; line-height: 16.0px; font: 13.0px Verdana; color: #222222; -webkit-text-stroke: #222222; background-color: #ffffff} p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; line-height: 16.0px; font: 13.0px Verdana; color: #222222; -webkit-text-stroke: #222222; background-color: #ffffff; min-height: 16.0px} p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; line-height: 12.0px; font: 12.0px Courier; color: #333333; -webkit-text-stroke: #222222; background-color: #f2f6f8} p.p5 {margin: 0.0px 0.0px 0.0px 0.0px; line-height: 12.0px; font: 12.0px Courier; color: #333333; -webkit-text-stroke: #222222; background-color: #f2f6f8; min-height: 14.0px} span.s1 {font-kerning: none; background-color: #ffffff} span.s2 {font-kerning: none} </style>
Thanks again!

 

[hiker95]

Hi Hiker95,

Thanks for taking the time. My spreadsheet actually has around 5000 rows and the columns to be transposed starts at column C and on indefinitely. Sorry I wasn't clear!

drew1230,

Can we see what your actual raw data worksheet looks like?

And, can we see what the results (manually formatted by you) should look like?

You can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com