Convert Data Columns to Rows in Excel

mminchev

New Member
Joined
Feb 16, 2018
Messages
23
Hi I am trying to convert the following data from a column into a row

Example

[TABLE="width: 154"]
<tbody>[TR]
[TD="width: 103, bgcolor: #666699"]People
[/TD]
[TD="width: 103, bgcolor: #666699"]Area
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]449
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]787
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]875
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]3555
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]3711
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]3760
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]4382
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]4558
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]4866
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]6344
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]6506
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]20
[/TD]
[TD="bgcolor: white"]7218
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]621
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]723
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]2117
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]2229
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]4751
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]5029
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]5223
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]5421
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]5433
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]5752
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]5753
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]5773
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]6431
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]6532
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]21
[/TD]
[TD="bgcolor: white"]6634
[/TD]
[/TR]
</tbody>[/TABLE]

End Result to look like this:

[TABLE="width: 139"]
<tbody>[TR]
[TD="width: 103, bgcolor: #666699"]20
[/TD]
[TD="width: 83, bgcolor: #666699"]21
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]449
[/TD]
[TD="bgcolor: white"]621
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]787
[/TD]
[TD="bgcolor: white"]723
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]875
[/TD]
[TD="bgcolor: white"]2117
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]3555
[/TD]
[TD="bgcolor: white"]2229
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]3711
[/TD]
[TD="bgcolor: white"]4751
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]3760
[/TD]
[TD="bgcolor: white"]5029
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]4382
[/TD]
[TD="bgcolor: white"]5223
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]4558
[/TD]
[TD="bgcolor: white"]5421
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]4866
[/TD]
[TD="bgcolor: white"]5433
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]6344
[/TD]
[TD="bgcolor: white"]5752
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]6506
[/TD]
[TD="bgcolor: white"]5753
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"]7218
[/TD]
[TD="bgcolor: white"]5773
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"][/TD]
[TD="bgcolor: white"]6431
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"][/TD]
[TD="bgcolor: white"]6532
[/TD]
[/TR]
[TR]
[TD="bgcolor: white"][/TD]
[TD="bgcolor: white"]6634
[/TD]
[/TR]
</tbody>[/TABLE]

I have hundreds of these rows and columns and I cant think of a way to do it easy.

PLEASE HELP!
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
This macro assumes your data is in columns A and B of "Sheet1". The output will be placed in "Sheet2")
Code:
Sub ConvertData()
    Application.ScreenUpdating = False
    Dim rngUniques As Range, rng As Range
    Dim LastRow As Long
    Dim lColumn As Long
    lColumn = 1
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Sheet1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:A" & LastRow), Unique:=True
    Set rngUniques = Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    Sheets("Sheet1").Range("A1").AutoFilter
    For Each rng In rngUniques
        Sheets("Sheet1").Range("A1:B" & LastRow).AutoFilter Field:=1, Criteria1:=rng
        Sheets("Sheet2").Cells(1, lColumn) = rng
        Sheets("Sheet1").Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet2").Cells(2, lColumn)
        lColumn = lColumn + 1
    Next rng
    Sheets("Sheet1").Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
This macro assumes your data is in columns A and B of "Sheet1". The output will be placed in "Sheet2")
Code:
Sub ConvertData()
    Application.ScreenUpdating = False
    Dim rngUniques As Range, rng As Range
    Dim LastRow As Long
    Dim lColumn As Long
    lColumn = 1
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Sheet1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:A" & LastRow), Unique:=True
    Set rngUniques = Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    Sheets("Sheet1").Range("A1").AutoFilter
    For Each rng In rngUniques
        Sheets("Sheet1").Range("A1:B" & LastRow).AutoFilter Field:=1, Criteria1:=rng
        Sheets("Sheet2").Cells(1, lColumn) = rng
        Sheets("Sheet1").Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet2").Cells(2, lColumn)
        lColumn = lColumn + 1
    Next rng
    Sheets("Sheet1").Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub


Did a little change to It and it worked great! THANK YOU!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
Upvote 0
Here is another macro that you can consider. It assumes your data is in Columns A and B, but rather than output the results to a different sheet, it places the output on the same sheet starting in Column D.
Code:
[table="width: 500"]
[tr]
	[td]Sub ConvertData()
  Dim N As Long, Ar As Range
  Range("D1").CurrentRegion.ClearContents
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Value = Evaluate(Replace("IF(@=" & .Offset(-1).Address & ",""=""&@,@)", "@", .Address))
  End With
  For Each Ar In Range("A2", Cells(Rows.Count, "B").End(xlUp).Offset(, -1)).SpecialCells(xlFormulas).Areas
    N = N + 1
    Range("C1").Offset(, N) = Ar(1).Offset(-1).Value
    Range("C1").Offset(1, N).Resize(Ar.Count + 1) = Ar.Offset(-1, 1).Resize(Ar.Count + 1).Value
  Next
  Columns("A").Replace "=", "", xlPart, , , , False, False
End Sub[/td]
[/tr]
[/table]
 
Upvote 0

Forum statistics

Threads
1,223,933
Messages
6,175,477
Members
452,646
Latest member
tudou

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top