Convert Rows to Columns

BruceHawk · Aug 5, 2017

I thought someone would have asked this, and they may have, but I was not successful in finding the answer in Excel.

I have a large spreadsheet in rows that I would like to copy and convert to columns.

Example of what I have:

Location	Data 1	Data 2	Data 3
Origin 1	Option 1	Alt 2	Other 1
Origin 2	Option 1	Alt 2	Other 1
Origin 3	Option 2	Alt 4	Other 1
Origin 4	Option 3	Alt 4	Other 1
Origin 5	Option 3	Alt 5	Other 2

What I would like to convert it to:

Location	Data
Origin 1	Option 1
	Alt 2
	Other 1
Origin 2	Option 1
	Alt 2
	Other 1
Origin 3	Option 2
	Alt 4
	Other 1
Origin 4	Option 3
	Alt 4
	Other 1
Origin 5	Option 3
	Alt 5
	Other 2

Help! Thanks!!

lrobbo314 · Aug 5, 2017

How about this?

Code:

Sub RowToColumn()

Dim LR As Long
Dim AR()
Dim ws As Worksheet
Dim iRow As Long


iRow = 1
LR = Range("A" & Rows.Count).End(xlUp).Row()
ReDim AR(1 To LR - 1, 1 To 2)


For i = 2 To LR
    AR(i - 1, 1) = Cells(i, 1)
    AR(i - 1, 2) = Range(Cells(i, 2), Cells(i, 4)).Value
Next i


Set ws = Worksheets.Add(After:=Sheets(Sheets.Count))


For i = 1 To UBound(AR)
    ws.Cells(iRow, 1) = AR(i, 1)
    ws.Cells(iRow, 2) = AR(i, 2)(1, 1)
    ws.Cells(iRow + 1, 2) = AR(i, 2)(1, 2)
    ws.Cells(iRow + 2, 2) = AR(i, 2)(1, 3)
    iRow = iRow + 3
Next i


End Sub

Akuini · Aug 5, 2017

Here’s another way.
Since you have a large data, it’s better to do most of the process in array.

Code:

[SIZE=3][COLOR=blue]Sub[/COLOR] a1017714a[B]()[/B]
[COLOR=blue]Dim[/COLOR] i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR][B],[/B] j [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR][B],[/B] va[B],[/B] vc
   
    [COLOR=blue]With[/COLOR] Range[B]([/B][COLOR=brown]"A2"[/COLOR][B],[/B] Cells[B]([/B]Rows.count[B],[/B] [COLOR=brown]"D"[/COLOR][B]).[/B][COLOR=blue]End[/COLOR][B]([/B]xlUp[B]))[/B]
        va [B]=[/B] [B].[/B]Value
        [B].[/B]ClearContents
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
 
[COLOR=blue]ReDim[/COLOR] vc[B]([/B][B][COLOR=crimson]1[/COLOR][/B] [COLOR=blue]To[/COLOR] UBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B] [B]*[/B] [B][COLOR=crimson]3[/COLOR][/B][B],[/B] [B][COLOR=crimson]1[/COLOR][/B] [COLOR=blue]To[/COLOR] [B][COLOR=crimson]2[/COLOR][/B][B])[/B]
   
    [COLOR=blue]For[/COLOR] i [B]=[/B] [B][COLOR=crimson]1[/COLOR][/B] [COLOR=blue]To[/COLOR] UBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B]
   
        vc[B]([/B]j [B]+[/B] [B][COLOR=crimson]1[/COLOR][/B][B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B] [B]=[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B]
        vc[B]([/B]j [B]+[/B] [B][COLOR=crimson]1[/COLOR][/B][B],[/B] [B][COLOR=crimson]2[/COLOR][/B][B])[/B] [B]=[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]2[/COLOR][/B][B])[/B]
        vc[B]([/B]j [B]+[/B] [B][COLOR=crimson]2[/COLOR][/B][B],[/B] [B][COLOR=crimson]2[/COLOR][/B][B])[/B] [B]=[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]3[/COLOR][/B][B])[/B]
        vc[B]([/B]j [B]+[/B] [B][COLOR=crimson]3[/COLOR][/B][B],[/B] [B][COLOR=crimson]2[/COLOR][/B][B])[/B] [B]=[/B] va[B]([/B]i[B],[/B] [B][COLOR=crimson]4[/COLOR][/B][B])[/B]
        j [B]=[/B] j [B]+[/B] [B][COLOR=crimson]3[/COLOR][/B]
   
    [COLOR=blue]Next[/COLOR]
 
Range[B]([/B][COLOR=brown]"A2"[/COLOR][B]).[/B]Resize[B]([/B]UBound[B]([/B]vc[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]),[/B] [B][COLOR=crimson]2[/COLOR][/B][B])[/B] [B]=[/B] vc
 
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR][/SIZE]

hiker95 · Aug 6, 2017

BruceHawk,

Here is another macro solution for you to consider, that uses two arrays in memory, and, will adjust to the number of raw data rows, and, columns, in the active worksheet, and, should be fast.

The results will be written in the active worksheet, beginning, in the third column to the right of the last used raw data column.

Code:

Sub ReorganizeData()
' hiker95, 08/06/2017, ME1017714
Application.ScreenUpdating = False
Dim a As Variant, i As Long, c As Long, lr As Long, lc As Long, n As Long
Dim o As Variant, j As Long
With ActiveSheet
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  n = Application.CountA(.Range(.Cells(2, 2), .Cells(lr, lc)))
  ReDim o(1 To n + 1, 1 To 2)
  j = j + 1: o(j, 1) = "Location": o(j, 2) = "Data"
  For i = 2 To UBound(a, 1)
    For c = 2 To UBound(a, 2)
      If c = 2 Then
        j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, c)
      Else
        j = j + 1: o(j, 2) = a(i, c)
      End If
    Next c
  Next i
  .Cells(1, lc + 3).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(lc + 3).Resize(, 2).AutoFit
End With
Application.ScreenUpdating = True
End Sub

BruceHawk · Aug 6, 2017

Hiker95, Thank you so much for your help. I found I understoond the second option you created best. I tested a few times with practice data, then did it on the real thing. Wow! Worked great. Thank you so much. (PS: Thanks for helping with the "Part 2" portion as well, that was in a separate thread!!)

hiker95 said:
BruceHawk,

Here is another macro solution for you to consider, that uses two arrays in memory, and, will adjust to the number of raw data rows, and, columns, in the active worksheet, and, should be fast.

The results will be written in the active worksheet, beginning, in the third column to the right of the last used raw data column.

Code:

Sub ReorganizeData() ' hiker95, 08/06/2017, ME1017714 Application.ScreenUpdating = False Dim a As Variant, i As Long, c As Long, lr As Long, lc As Long, n As Long Dim o As Variant, j As Long With ActiveSheet lr = .Cells(Rows.Count, 1).End(xlUp).Row lc = .Cells(1, Columns.Count).End(xlToLeft).Column a = .Range(.Cells(1, 1), .Cells(lr, lc)) n = Application.CountA(.Range(.Cells(2, 2), .Cells(lr, lc))) ReDim o(1 To n + 1, 1 To 2) j = j + 1: o(j, 1) = "Location": o(j, 2) = "Data" For i = 2 To UBound(a, 1) For c = 2 To UBound(a, 2) If c = 2 Then j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, c) Else j = j + 1: o(j, 2) = a(i, c) End If Next c Next i .Cells(1, lc + 3).Resize(UBound(o, 1), UBound(o, 2)) = o .Columns(lc + 3).Resize(, 2).AutoFit End With Application.ScreenUpdating = True End Sub

hiker95 · Aug 6, 2017

Re: Convert Rows to Columns
Hiker95, Thank you so much for your help. I found I understoond the second option you created best. I tested a few times with practice data, then did it on the real thing. Wow! Worked great. Thank you so much.

BruceHawk,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

hiker95 · Aug 6, 2017

(PS: Thanks for helping with the "Part 2" portion as well, that was in a separate thread!!)

BruceHawk,

I will check out your other thread.

Mike Szczesny · Aug 8, 2017

Can you use something like this. This is a crazy complicated formula, but it is robust. I am just focusing on the data part of your problem. You need to use Cntrl+Shift+Enter. Copy down.

=INDEX($B$2:$D$5,INT(SMALL(IF($B$2:$D$5<>"",(ROW($B$2:$D$5)-ROW($B$2)+1)*10^9+COLUMN($B$2:$D$5)-COLUMN($B$2)+1),ROWS($B$8:B8))/10^9),MOD(SMALL(IF($B$2:$D$5<>"",(ROW($B$2:$D$5)-ROW($B$2)+1)*10^9+COLUMN($B$2:$D$5)-COLUMN($B$2)+1),ROWS($B$8:B8)),10^9))

Data1	Data2	Data3
a	b	c
d	e	f
g	h	i
j	k	l

Data
a
b
c
d
e
f
g
h
i
j
k
l

BruceHawk · Aug 26, 2017

hiker95

The macro array below is potent...but only works if if there are no blanks in the data. Unfortunately, in many of places in the actual data there are blanks. Here's an example:

Location	Data 1	Data 2	Data 3
Origin 1	Option 1	Alt 2	Other 1
Origin 2	Option 1	Alt 2	Other 1
Origin 3	Option 2		Other 1
Origin 4		Alt 4	Other 1
Origin 5	Option 3	Alt 5	Other 2

With blanks I get a run time error in the spot below highlighted in red.

Sub ReorganizeData()
' hiker95, 08/06/2017, ME1017714
Application.ScreenUpdating = False
Dim a As Variant, i As Long, c As Long, lr As Long, lc As Long, n As Long
Dim o As Variant, j As Long
With ActiveSheet
lr = .Cells(Rows.Count, 1).End(xlUp).Row
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
a = .Range(.Cells(1, 1), .Cells(lr, lc))
n = Application.CountA(.Range(.Cells(2, 2), .Cells(lr, lc)))
ReDim o(1 To n + 1, 1 To 2)
j = j + 1: o(j, 1) = "Location": o(j, 2) = "Data"
For i = 2 To UBound(a, 1)
For c = 2 To UBound(a, 2)
If c = 2 Then
j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, c)
Else
j = j + 1: o(j, 2) = a(i, c)
End If
Next c
Next i
.Cells(1, lc + 3).Resize(UBound(o, 1), UBound(o, 2)) = o
.Columns(lc + 3).Resize(, 2).AutoFit
End With
Application.ScreenUpdating = True
End Sub

hiker95 · Aug 26, 2017

BruceHawk,

And, what should the results look like with your new raw data?

Convert Rows to Columns

BruceHawk

New Member

Excel Facts

lrobbo314

Well-known Member

Akuini

Well-known Member

hiker95

Well-known Member

BruceHawk

New Member

hiker95

Well-known Member

hiker95

Well-known Member

Mike Szczesny

Active Member

BruceHawk

New Member

hiker95

Well-known Member

Similar threads

Forum statistics

Share this page

Convert Rows to Columns

New Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

New Member

Well-known Member

Well-known Member

Active Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock