We help IT Professionals succeed at work.

Manipulate how Excel data is displayed

Manipulate how data is displayedQuestion:
In the attached Excel file, Sheet1 shows how my data is currently laid out.  I would like to change the layout to how it is shown in Sheet2.  In Sheet2 the sequence of the rows does not matter.  

If a solution can be given in MS Access that would be acceptable too.

Note that the data in my "real" file has a lot more rows and columns of data than the sample data in the attached file. Thanks.  EE01.xlsx
Comment
Watch Question

Top Expert 2008
Commented:
Install the attached add-in, Table2DB
Select Sheet1, cell C2 (first rate cell) and run the add-in

Thomas
Table2DB.xla
Excel VBA Developer
Top Expert 2014
Commented:
The following code will transform the data given the following conditions:
1) The macro is run when the original data set is visible (i.e., Sheet1)
2) State columns begin in column 3 and continue onward
3) There are no blank rows

The code will create a new sheet named "NEW" and place the transformed data there.

-Glenn


Sub Transform_Array()
    Dim rng, rngCat As Range
    Dim r, c, i As Integer
    Dim intCurrRow As Integer
    Dim strSource, strST As String
    strSource = ActiveSheet.Name
    Set rng = ActiveSheet.Range("A1").CurrentRegion
    i = rng.Columns.Count
    r = rng.Rows.Count - 1
    Set rngCat = Range("A2:B" & r + 1)
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "NEW"
    Range("A1").Value = "PrdNam"
    Range("B1").Value = "Tiers"
    Range("C1").Value = "STATE"
    Range("D1").Value = "Rate"
    Range("A2").Select
    intCurrRow = 2
    For c = 3 To i
        Sheets(strSource).Activate
        strST = Cells(1, c).Value
        rngCat.Copy
        Sheets("NEW").Activate
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        Range(Cells(intCurrRow, 3), Cells(intCurrRow + r - 1, 3)).Value = strST
        Sheets(strSource).Activate
        Range(Cells(2, c), Cells(r + 1, c)).Copy
        Sheets("NEW").Activate
        Cells(intCurrRow, 4).Activate
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        intCurrRow = intCurrRow + r
        Cells(intCurrRow, 1).Select
        Sheets(strSource).Activate
    Next c
    MsgBox "Done."
End Sub

Open in new window

Author

Commented:
Thanks, Thomas and Glen.  Pls give me some time to try it.

Author

Commented:
I will be posting a follow-up question to Glen's solution ,,,