[Previous] [Contents] [Next]

Put It All Together

Listing 1 produces the product line manager reports in a few seconds.

Listing 1. Code That Produces the Product Line Report in Figure 10

Sub ProductLineReport()
    ' Line of Business and Market as Row
    ' Years as Column
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Dim GrandRow As Long
    Dim FinalReportRow as Long
    Dim i as Integer
    Dim TotColumns()

    Set WSD = Worksheets("PivotTable")
    Dim WSR As Worksheet
    Dim WBO As Workbook
    Dim WBN As Workbook
    Set WBO = ActiveWorkbook

    ' Delete any prior pivot tables
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT

    ' Define input area and set up a Pivot Cache
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Create the Pivot Table from the Pivot Cache
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="PivotTable1")

    ' Turn off updating while building the table
    PT.ManualUpdate = True

    ' Set up the row fields
    PT.AddFields RowFields:=Array("Line of Business", _
        "In Balance Date"), ColumnFields:="Market"

    ' Set up the data fields
    With PT.PivotFields("Revenue")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With

    ' Calc the pivot table
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' Group by Year
    Cells(3, FinalCol + 3).Group Start:=True, End:=True, _
        Periods:=Array(False, False, False, False, False, False, True)

    ' Move In Balance Date to columns
    PT.PivotFields("In Balance Date").Orientation = xlColumnField
    PT.PivotFields("Market").Orientation = xlRowField

    PT.PivotFields("Sum of Revenue").NumberFormat = "#,##0,K"
    PT.PivotFields("Line of Business").Subtotals(1) = True
    PT.PivotFields("Line of Business").Subtotals(1) = False
    PT.ColumnGrand = False

    ' Calc the pivot table
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' PT.TableRange2.Select

    ' Create a New Blank Workbook with one Worksheet
    Set WBN = Workbooks.Add(xlWBATWorksheet)
    Set WSR = WBN.Worksheets(1)
    WSR.Name = "Report"
    ' Set up Title for Report
    With WSR.[A1]
        .Value = "Revenue by Market and Year"
        .Font.Size = 14
    End With

    ' Copy the Pivot Table data to row 3 of the Report sheet
    ' Use Offset to eliminate the title row of the pivot table
    PT.TableRange2.Offset(1, 0).Copy
    WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    PT.TableRange2.Clear
    Set PTCache = Nothing

    ' Fill in the Outline view in column A
    ' Look for last row in column B since many rows
    ' in column A are blank
    FinalReportRow = WSR.Range("B65536").End(xlUp).Row
    With Range("A3").Resize(FinalReportRow - 2, 1)
        With .SpecialCells(xlCellTypeBlanks)
            .FormulaR1C1 = "=R[-1]C"
        End With
        .Value = .Value
    End With

    ' Do some basic formatting
    ' Autofit columns, bold the headings, right-align
    Selection.Columns.AutoFit
    Range("A3").EntireRow.Font.Bold = True
    Range("A3").EntireRow.HorizontalAlignment = xlRight
    Range("A3:B3").HorizontalAlignment = xlLeft

    ' Repeat rows 1-3 at the top of each page
    WSR.PageSetup.PrintTitleRows = "$1:$3"

    ' Add subtotals
    FinalCol = Cells(3, 255).End(xlToLeft).Column
    ReDim Preserve TotColumns(1 To FinalCol - 2)
    For i = 3 To FinalCol
        TotColumns(i - 2) = i
    Next i
    Selection.Subtotal GroupBy:=1, Function:=xlSum, _
        TotalList:=TotColumns, Replace:=True, _
        PageBreaks:=True, SummaryBelowData:=True

    ' Make sure the columns are wide enough for totals
    GrandRow = Range("A65536").End(xlUp).Row
    Cells(3, 3).Resize(GrandRow - 2, FinalCol - 2).Columns.AutoFit
    Cells(GrandRow, 3).Resize(1, FinalCol - 2).NumberFormat = "#,##0,K"
    ' Add a page break before the Grand Total row, otherwise
    ' the product manager for the final Line will have two totals
    WSR.HPageBreaks.Add Before:=Cells(GrandRow, 1)

End Sub

10. It takes less than two seconds to convert 50,000 rows of transactional data to this useful report if you use the code that produced this example. Without pivot tables, the code would be far more complex.

Figure 10 shows the report produced by this code.

[Previous] [Contents] [Next]