Convert column data to rows

cybersonic

New Member
Joined
Aug 14, 2015
Messages
1
Hi,
Does anyone have a solution for this excel task:

NameLevel1Level2Level3
A1/2/20003/5/20009/9/2000
B2/2/20035/5/200410/7/2005
C3/4/20014/4/200211/13/2005

<tbody>
</tbody>

Convert the above to look like:

NameLevelsDate
ALevel11/2/2000
ALevel23/5/2000
ALevel39/9/2000
BLevel12/2/2003
BLevel25/5/2004
BLevel310/7/2005
CLevel13/4/2001
CLevel24/4/2002
CLevel311/13/2005

<tbody>
</tbody>
 

brucef2112

Board Regular
Joined
Dec 11, 2012
Messages
235
Re: Convert column data table to flat data rows

Puertorekinsam created this exact solution for someone else just last month.
http://www.mrexcel.com/forum/excel-questions/865501-convert-multiple-rows-columns-into-individual-rows-each-col-head-data.html#post4202839

It works beautifully!

put the code in a module
His function expects to find your data with column headers starting in cell A1 on Sheet1.
It also expect to find a Sheet2 (which is where the flattened data will be created.

Run the macro. Blink. Then go to sheet2 to see the magic.

This forum boasts a wonderful search feature. Give it a try.
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,411
Re: Convert column data table to flat data rows

Here is code you don't need to change except the sheet references.

Code:
Sub How_About_This()
    'http://www.excelforum.com/excel-programming-vba-macros/942304-solve-this-offset-issue.html
    'By: Leith Ross
    Dim Cell As Range
    Dim Data(1 To 3) As Variant
    Dim DstRng As Range
    Dim r As Long
    Dim Rng As Range
    Dim RngEnd As Range
    Dim headerArr
        headerArr = Array("Name", "Levels", "Date")
        Set Rng = Sheet2.Range("A2")
        Set DstRng = Sheet3.Range("A2:C2")
            Set RngEnd = Sheet2.Cells(Rows.Count, "A").End(xlUp)
            If RngEnd.Row > Rng.Row Then Set Rng = Range(Rng, RngEnd)
            Sheets("Sheet3").Range("A1:C1") = headerArr
            For Each Cell In Rng
                Data(1) = Array(Cell.Value, Cell.Value, Cell.Value)
                Data(2) = Array("Level1", "Level2", "Level3")
                Data(3) = Array(Cell.Item(1, 2), Cell.Item(1, 3), Cell.Item(1, 4))
                DstRng.Offset(r, 0).Resize(3, 3).Value = Application.Transpose(Data)
                r = r + 3
            Next Cell
End Sub
 

Forum statistics

Threads
1,081,560
Messages
5,359,608
Members
400,538
Latest member
leon_oscar

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top