How to build a consolidated pivot table when the source data contains column headings that are dates?

Question

I have a customer who is currently using Excel to do their staff planning. They have many workbooks for different projects and each project contains 1 or more sheets containing the actual staffing data:

The customer wants to consolidate all of the data from all of these many sheets and workbooks into a single pivot table. A 'consolidated' pivot is not an option because they want to be able to mess with all of the (non-date) fields in the source data. They don't want to be limited to only 'Row' and 'Column'. My current solution is a macro that consolidates all of the data within a workbook through a fairly convoluted copy and rotate process. I copy a row of 'meta data' (everything that's not a date) first, then I copy / transpose the dates for the meta data row into a single 'Date' column. Then I extend the meta data so that the same data is defined for each date.

I have a separate workbook that grabs the consolidated sheet from each workbook and builds a single pivot table from them.

It works, but it's pretty inefficient, since the total number of tasks / assignments number in the many thousands. In my dreams, I would love to eliminate the consolidation step completely, but I don't see that happening. A more efficient consolidation approach is about the best I'm hoping for at this point.

If anyone has some 'outside the box' ideas, I'm all ears! The solutions needs to work on windows XP, Office 2002 and 2003.

Answer 1

I finally found an acceptable solution, if anyone is interested. It's uses a combination of a Pivot Table and the TextToColumns function. Once I had the approach, turing it into code was pretty simple. The code below does refer to a few conveniance functions I use, such as 'DeleteSheet' and 'LastRowOn', but you get the idea.

Sub Foo()
    Dim ws As Worksheet
    For Each ws In Worksheets
        If IsStaffingSheet(ws) Then
            ws.Select
            DeleteSheet ws.Name & " - Exploded"
            TransposeSheet ws
        End If
    Next ws

End Sub

Sub TransposeSheet(ByVal ParentSheet As Worksheet)
    Dim ws As Worksheet
    Dim r As Range
    Dim ref As Variant
    Dim pt As PivotTable

    Set r = Range("StaffingStartCell")
    Set r = Range(r, r.SpecialCells(xlLastCell))

    ref = Array("'" & ActiveSheet.Name _
                    & "'!" & r.Address(ReferenceStyle:=xlR1C1))

    Application.CutCopyMode = False
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlConsolidation, _
                                   SourceData:=ref).CreatePivotTable TableDestination:="", _
        tableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10

    Set ws = ActiveSheet
    Set pt = ws.PivotTableWizard(TableDestination:=ActiveSheet.Cells(3, 1))
    pt.DataPivotField.PivotItems("Count of Value").Position = 1
    pt.PivotFields("Row").PivotItems("").Visible = False

    ExplodePivot ParentSheet
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True

    Set ws = Nothing
End Sub


Sub ExplodePivot(ByVal ParentSheet As Worksheet)
    Dim lastRow As Long
    Dim lastCol As Long

    lastRow = LastRowOn(ActiveSheet.Name)
    lastCol = LastColumnBack(ActiveSheet, lastRow)

    Cells(lastRow, lastCol).ShowDetail = True

    Columns("B:C").Select
    Selection.Cut Destination:=Columns("S:T")

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), _
                            DataType:=xlDelimited, _
                            Semicolon:=True
    Selection.ColumnWidth = 12
    ActiveSheet.Name = ParentSheet.Name & " - Exploded"
End Sub