Convert column data to rows

[cybersonic]

Hi,
Does anyone have a solution for this excel task:

Name	Level1	Level2	Level3
A	1/2/2000	3/5/2000	9/9/2000
B	2/2/2003	5/5/2004	10/7/2005
C	3/4/2001	4/4/2002	11/13/2005

<tbody>
</tbody>

Convert the above to look like:

Name	Levels	Date
A	Level1	1/2/2000
A	Level2	3/5/2000
A	Level3	9/9/2000
B	Level1	2/2/2003
B	Level2	5/5/2004
B	Level3	10/7/2005
C	Level1	3/4/2001
C	Level2	4/4/2002
C	Level3	11/13/2005

<tbody>
</tbody>

 

[brucef2112]

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]

Re: Convert column data table to flat data rows

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

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