Taking multi column horizonally organized and changing it to vertical--Urgent

Hi All!

I have a project that I really could use your help resolving.  Attached is an excel file with two tabs.  The tab labeled 4-10 is the way the data is created currently.  The results tab is what I would like to see.  This is a weekly file that is created and the column lengths are not standard week to week.  Other than the length of the column everything else stays the same.  

Ideally I would like a vba script that would create the tab "results" and populate as required.  Instead of the days of the week being horizontal I need to get them vertically stacked with the new labels (issue date).  

Much thanks all!

spudmcc RetFile-4-10-11.xlsm
spudmccAsked:
Who is Participating?
 
jppintoCommented:
Can you try this code?

jppinto
Sub Table()
Dim lstRow As Long
Dim x As Long
Dim y As Long
Dim SheetCnt As Integer
Dim row As Long

'Delete the Results Sheet on the document (in case it exists)
Sheets("Results").Delete

SheetCnt = Worksheets.Count
'Add the Target Sheet
Sheets.Add after:=Worksheets(SheetCnt)
ActiveSheet.Name = "Results"
Sheets("Results").Range("A1") = "Route ID"
Sheets("Results").Range("B1") = "Issue"
Sheets("Results").Range("C1") = "Returns"
row = 2

lstRow = Sheets("4.10").Cells(Sheets("4.10").Rows.Count, "A").End(xlUp).row

For y = 2 To 8
    For x = 2 To lstRow
        Sheets("Results").Cells(row, 1).Value = Sheets("4.10").Cells(x, 1).Value
        Sheets("Results").Cells(row, 2).Value = Sheets("4.10").Cells(1, y).Value
        Sheets("Results").Cells(row, 3).Value = Sheets("4.10").Cells(x, y).Value
        row = row + 1
    Next x
Next y

End Sub

Open in new window

0
 
Ardhendu SarangiSr. Project ManagerCommented:
hi,
You can do this quickly as a Pivot Table. please see attached...
RetFile-4-10-11.xlsm
0
 
jppintoCommented:
The number of columns is always the same?
0
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

 
Ardhendu SarangiSr. Project ManagerCommented:
Here's the updated spreadsheet -
RetFile-4-10-11.xlsm
0
 
spudmccAuthor Commented:
A pivot table is a wonderful thing but in this case I would like a vba script that does everything from creating the "results" tab, labeling the columns and populating correctly.  

spudmcc
0
 
Ardhendu SarangiSr. Project ManagerCommented:
Hi,
Can you try the following VBA and see if this works for you -



Sub CreateMe()
Application.DisplayAlerts = False
    Set ws1 = Sheets("Results")
    For p = Worksheets.Count To 1 Step -1
        'MsgBox (p & "-" & Worksheets(p).Name)
        If Worksheets(p).Name <> "Results" Then Worksheets(p).Delete
    Next
    Sheets.Add
    Set ws2 = ActiveSheet
    ws1.Select
    ws1.Range("A1").Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Results!R1C1:R57C3", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:=ws2.Range("A1"), TableName:="PivotTable2", DefaultVersion _
        :=xlPivotTableVersion14
    ws2.Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Route ID")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Issue")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Returns"), "Sum of Returns", xlSum
        Rows("2:2").Select
    Selection.NumberFormat = "[$-409]d-mmm-yyyy;@"
    Cells.Select
    Cells.EntireColumn.AutoFit
    
End Sub

Open in new window

RetFile-4-10-11.xlsm
0
 
spudmccAuthor Commented:
I couldn't get it to work.  I got a "run-time" 5 error.  I do want to clarify that I am starting with the tab labeled with the date and want to end up with something that looks like the "results" tab.  

spudmcc
0
 
jppintoCommented:
Attached working example.

jppinto
RetFile-4-10-11-test.xlsm
0
 
jppintoCommented:
Any news?
0
 
spudmccAuthor Commented:
This is exactly what I was looking for to resolve this issue.  Thank you so much for your knowledge, patience and quick response.  

spudmcc (Andy)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.