Building a Library of Routines – Setup_Pivot

This next function is the heart and soul of creating Pivot Tables.  It’s purpose is to reduce the many Pivot Table properties and methods down to just one function and as few meaningful parameters as possible to create every Pivot Table my customers have every asked for.  Hopefully, your customers aren’t any more demanding.

Copy this to your modGeneral as before.  We will add one more routine for creating Pivot Charts, and then I will show you how to ”snap” these routines into our Northwind data extract to create impactful graphs and dynamic drill downs. 

Function Setup_Pivot(sWorksheet As String, sDataRange As String, _
                     sTitle As String, sPageFields() As String, _
                     sRowFields() As String, sColumnFields() As String, _
                     sDataFields() As String, sSortFields() As String, _
                     sMaxFields() As String) As Boolean

'   Setup_Pivot:    Set up a Pivot Table Worksheet and Pivot Table

'   Parameters:    
'       sWorkSheet      - The worksheet name where the Pivot Table will be placed
'                         and the Pivot Table name.
'       sDataRange      - The data range (raw data/database extract)
'       sTitle          - A Title to put above the pivot table
'       sRowFields(#)   - Column headers in the data range that will appear
'                         down the left of the pivot table
'       sColumnFields(#)- Column headers in the data range that will appear
'                         across the top of the pivot table
'       sDataFields(#,2)
'                   #,0 = Column headers (field name) in the data range that
'                         will be in the body of the pivot table
'                   #,1 = Operation to be performed on the data (sum,count,etc.)
'                   #,2 = Caption to use for the resulting data field
'       sSortFields(#,2)
'                   #,0 = Row or Column field to sort
'                   #,1 = Ascending or Descending order
'                   #,2 = Data field to use to sort by
'       MaxFields(#,2)
'                   #,0 = Row or Column field to restrict
'                   #,1 = Max Number of entries to display
'                   #,2 = Data field to restrict by
'   Example:
'       Setup_Pivot sWorkSheet, sDataRange, sTitle, _
'                   sPageFields(), sRowFields(), sColumnFields(), sDataFields(), _
'                   sSortFields(), sMaxFields()

'     Date   Init Modification
'   01/12/06 CWH  Initial Programming Copyright 2009 Craig Hatmaker
   
    On Error GoTo ErrHandler            '
    Setup_Pivot = Failure               'Assume the Worst
               
    Settings "Save"                     'Save current settings
    Settings "Disable"                  'Disable events, updating, calculations
   
'   Dim Statements
    Dim i As Integer
       
'   Check for the Pivot Table Worksheet and create it if it doesn't exist
    If Not WorkSheetExists(sWorksheet) Then
        Sheets.Add
        Sheets(ActiveSheet.Name).Name = sWorksheet
    Else
        Worksheets(sWorksheet).Activate
        Cells.Select
        Selection.Clear
    End If

    If PivotTableExists(sWorksheet, sWorksheet) Then
'       Just Refresh the Pivot Table if it already exists
        Worksheets(sWorksheet).PivotTables(sWorksheet).RefreshTable
    Else
'        Create the Pivot Table if it doesnt' exist
         ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
                                        SourceData:=sDataRange).CreatePivotTable _
                                        TableDestination:=Range("A4"), _
                                        TableName:=sWorksheet
         With ActiveSheet.PivotTables(sWorksheet)
            .SmallGrid = False
           
'           Add Pivot Table Page Field   
            For i = 0 To UBound(sPageFields())
                If sPageFields(i) <= "" Then Exit For
                With .PivotFields(sPageFields(i))
                   .Orientation = xlPageField
                   .Subtotals = Array( _
                     False, False, False, False, False, False, _
                     False, False, False, False, False, False)
                End With
            Next i

'           Add Pivot Table Row Fields   
            For i = 0 To UBound(sRowFields())
                If sRowFields(i) <= "" Then Exit For
                With .PivotFields(sRowFields(i))
                   .Orientation = xlRowField
                   .Subtotals = Array( _
                     False, False, False, False, False, False, _
                     False, False, False, False, False, False)
                End With
            Next i

'           Add Pivot Table Column Fields   
            For i = 0 To UBound(sColumnFields())
                If sColumnFields(i) <= "" Then Exit For
                With .PivotFields(sColumnFields(i))
                   .Orientation = xlColumnField
                   .Subtotals = Array( _
                     False, False, False, False, False, False, _
                     False, False, False, False, False, False)
                End With
            Next i

'           Add Pivot Table Data Fields, Function & Format   
            For i = 0 To UBound(sDataFields(), 1)
                If sDataFields(i, 0) <= "" Then Exit For
                With .PivotFields(sDataFields(i, 0))
                    .Orientation = xlDataField
                    If sDataFields(i, 1) <= "" Then sDataFields(i, 1) = "Count"
                    Select Case UCase(sDataFields(i, 1))
                        Case Is = "SUM"
                            .Function = xlSum
                        Case Is = "AVERAGE"
                            .Function = xlAverage
                        Case Is = "MAX"
                            .Function = xlMax
                        Case Is = "MIN"
                            .Function = xlMin
                        Case Is = "COUNTNUMS"
                            .Function = xlCountNums
                        Case Is = "PRODUCT"
                            .Function = xlProduct
                        Case Is = "STDEVP"
                            .Function = xlStDevP
                        Case Else
                            .Function = xlCount
                    End Select
                    .NumberFormat = "#,###.00_);[Red](#,###.00)"
                    If sDataFields(i, 2) <= "" Then sDataFields(i, 2) = _
                       sDataFields(i, 1) & " of " & sDataFields(i, 0)
                    .Caption = sDataFields(i, 2)
                End With
            Next i

'           Sort columns and rows   
            For i = 0 To UBound(sSortFields(), 1)
                If sSortFields(i, 0) <= "" Then Exit For
                If sSortFields(i, 1) = "Descending" Then
                    .PivotFields(sSortFields(i, 0)).AutoSort _
                    xlDescending, sSortFields(i, 2)
                Else
                    .PivotFields(sSortFields(i, 0)).AutoSort _
                    xlAscending, sSortFields(i, 2)
                End If
            Next i

'           Restrict to top/bottom entries   
            For i = 0 To UBound(sMaxFields(), 1)
                If sMaxFields(i, 0) <= "" Then Exit For
                If sMaxFields(i, 1) > 0 Then
                    .PivotFields(sMaxFields(i, 0)).AutoShow _
                    xlAutomatic, xlTop, Val(sMaxFields(i, 1)), sMaxFields(i, 2)
                Else
                    .PivotFields(sMaxFields(i, 0)).AutoShow _
                    xlAutomatic, xlBottom, Val(sMaxFields(i, 1)) * -1, _
                        sMaxFields(i, 2)
                End If
            Next i
        End With

 '      Orient datafields in columns         
        If UBound(sDataFields(), 1) > 0 Then
            With ActiveSheet.PivotTables(sWorksheet).DataPivotField
                .Orientation = xlColumnField
                .Position = 1
            End With
        End If

'       Freeze panes on row and column titles                  
        Range(ActiveSheet.PivotTables(sWorksheet).DataBodyRange.Address). _
            Cells(1, 1).Select
        ActiveWindow.FreezePanes = True
   
    End If

'   Add Worksheet Title   
    With Worksheets(sWorksheet)
        .Rows("1:1").MergeCells = False
        Range(.Cells(1, 1), .Cells(1, .PivotTables(sWorksheet).TableRange1. _
            Columns.Count)).Merge
        .Cells(1, 1) = sTitle
        .Cells(1, 1).Font.Bold = True
        .Cells(1, 1).HorizontalAlignment = xlHAlignLeft
    End With
       
    Setup_Pivot = Success               'Successful finish

ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Setup_Pivot - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    Settings "Restore"                  'Restore active window & settings
    On Error GoTo 0

End Function

How to Copy Code from this Blog to XL

1. Open your XL spreadsheet containing modGeneral.
2. Get to the VBE (Alt-F11)
3. Open modGeneral in the Code Window
4. From this post, select and copy the code
5. Paste into the Code Window (*see next paragraph)
6. Make any corrections to code that didn’t paste correctly
7. From the VBE menu navigate File > Export File…
8. Save modGeneral and remember where you saved it.

Unfortunately, the code won’t paste 100% properly.  You will have to add carriage returns and perhaps fix a few things until your code looks exactly like what you see here.