VBA to create a Pivot Table

Option Explicit

'**
 ' Call each of the individual Pivot Table creation functions
 ''
Function do_pivot_tables()

    Debug.Print "    Creating Pivot Table 'MattersByYear' on sheet 'Number of Matters Opened' -" & vbCrLf
    Call do_pivot_matter_by_year

End Function

'**
 ' Set the parameters for and create the "MattersByYear" Pivot Table
 ''
Function do_pivot_matter_by_year()

Dim pivot_name As Variant           ' The name of the Pivot Table
Dim sheet_name As Variant           ' The name of the sheet that will hold the Pivot Table
Dim sheet_exists As Boolean         ' Whether or not the worksheet for this Pivot Table already exists
Dim row_fields(0) As Variant        ' The row fields for the Pitot Table
Dim column_fields(0) As Variant     ' The column fields for the Pitot Table
Dim data_fields(0, 1) As Variant    ' The data fields for the Pitot Table
Dim filter_fields(2) As Variant     ' The filter fields for the Pitot Table
Dim pivot_title As String           ' The title of the Pivot Table (to display to the user)
Dim pivot_title_range As String     ' The range that should contain to pivot title

    ' Set the "Number of Matters Opened" Pivot Table options
    pivot_name = "MattersByYear"
    sheet_name = "Number of Matters Opened"

    ' Check to see if the "Number of Matters Opened" Pivot Table already exists, and exit the function if it does not
    Debug.Print "        Checking if the sheet 'Number of Matters Opened' exists -"
    sheet_exists = worksheet_exists("Number of Matters Opened")
    If sheet_exists = True Then
        Debug.Print "            Sheet exists, exiting functions" & vbCrLf
        Exit Function
    Else
        Debug.Print "            Sheet does not exist, creating Pivot Table" & vbCrLf
    End If

    ' The row fields
    row_fields(0) = "Fee earner name"

    ' The column fields
    column_fields(0) = "Matter open year"

    ' The data fields
    data_fields(0, 0) = "Matter code"
    data_fields(0, 1) = "Count"

    ' The filter fields
    filter_fields(0) = "Fee earner code"
    filter_fields(1) = "Department code"
    filter_fields(2) = "Work type code"

    ' The title
    pivot_title = "Matters Opened per Year by Fee Earner"
    pivot_title_range = "B3:G4"

    ' Create the Pivot Table
    Call create_pivot_table(pivot_name, sheet_name, row_fields, column_fields, data_fields, filter_fields, pivot_title, pivot_title_range)

End Function

'**
 ' Creates a Pivot Table using the parameters parsed
 '
Function create_pivot_table( _
    pivot_name As Variant, _
    sheet_name As Variant, _
    Optional row_fields As Variant = "", _
    Optional column_fields As Variant = "", _
    Optional data_fields As Variant = "", _
    Optional filter_fields As Variant = "", _
    Optional pivot_title As String = "", _
    Optional pivot_title_range As String = "" _
)

Dim position_row As Integer ' The row number to place the new pivot table at
Dim position As String      ' The position of the Pivot Table on the worksheet
Dim source_data As String   ' The source of the data used for the Pivot Table
Dim title_range As Range    ' The Range to be used for the title of the Pivot Table
Dim i As Integer            ' Dummy for looping

    ' The source data for the new Pivot Table
    source_data = "v10List"
    position_row = 9 + UBound(filter_fields)
    position = "'" & sheet_name & "'!R" & position_row & "C2"

    ' Create a new sheet and rename it
    Debug.Print "        Creating new Sheet for Pivot Table and renaming it - " & sheet_name & vbCrLf
    Sheets.Add
    ActiveSheet.Name = sheet_name

    ' Create the Pivot Table
    Debug.Print "        Adding Pivot Table - "
    Debug.Print "            Pivot Table Name - " & pivot_name
    Debug.Print "            Pivot Table Source - " & source_data & vbCrLf
    ActiveWorkbook.PivotCaches.Add( _
        SourceType:=xlDatabase, _
        SourceData:=source_data).CreatePivotTable _
            TableDestination:=position, _
            TableName:=pivot_name, _
            DefaultVersion:=xlPivotTableVersion10

    ' Add the row fields
    Debug.Print "        Adding Pivot Rows - "
    For i = 0 To UBound(row_fields) Step 1
        Debug.Print "            Adding Pivot Row - " & row_fields(i)
        With ActiveSheet.PivotTables(pivot_name).PivotFields(row_fields(i))
            .Orientation = xlRowField
            .position = i + 1
        End With
    Next
    Debug.Print "" ' Add a blank line to seperate output in the Immediate window

    ' Add the column fields
    Debug.Print "        Adding Pivot Columns - "
    For i = 0 To UBound(column_fields) Step 1
        Debug.Print "            Adding Pivot Column - " & column_fields(i)
        With ActiveSheet.PivotTables(pivot_name).PivotFields(column_fields(i))
            .Orientation = xlColumnField
            .position = i + 1
        End With
    Next
    Debug.Print "" ' Add a blank line to seperate output in the Immediate window

    ' Add the data fields
    Debug.Print "        Adding Pivot Data - "
    For i = 0 To UBound(data_fields) Step 1
        Debug.Print "            Adding Pivot Data - " & data_fields(i, 0) & " (" & data_fields(i, 1) & ")"
        ActiveSheet.PivotTables(pivot_name).AddDataField _
        ActiveSheet.PivotTables(pivot_name).PivotFields(data_fields(i, 0)), data_fields(i, 1) & " of " & data_fields(i, 0), xlCount
    Next
    Debug.Print "" ' Add a blank line to seperate output in the Immediate window

    ' Add the filter fields
    Debug.Print "        Adding Pivot Filters - "
    For i = 0 To UBound(filter_fields) Step 1
        Debug.Print "            Adding Pivot Filter - " & filter_fields(i)
        With ActiveSheet.PivotTables(pivot_name).PivotFields(filter_fields(i))
            .Orientation = xlPageField
            .position = 1
        End With
    Next
    Debug.Print "" ' Add a blank line to seperate output in the Immediate window

    ' Check to see if there is a title for the Pivot Table, and exit if there is not
    Debug.Print "        Checking Pivot Table title existence - "
    If pivot_title = "" Then
        Debug.Print "            No title was set, deleting title rows" & vbCrLf
        ActiveSheet.Range("1:4").EntireRow.Delete
        Exit Function
    Else
        Debug.Print "            Title was set by user - " & pivot_title & vbCrLf
    End If

    ' Check to see if a range for the Pivot Table title has been set, and set one if not
    Debug.Print "        Checking Pivot Table title range existence - "
    If pivot_title_range = "" Then
        Debug.Print "            Range was set using default - Range(""B3: E4"")" & vbCrLf
        title_range = ActiveSheet.Range("B3:E4")
    Else
        Debug.Print "            Range was set by user - Range(""" & pivot_title_range & """)" & vbCrLf
        title_range = ActiveSheet.Range(pivot_title_range)
    End If

    ' Merge the cells that will contain the Pivot Table title
    Debug.Print "        Merging title range cells" & vbCrLf
    title_range.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge

    ' Format the newly merged cell that will contain the Pivot Table title
    Debug.Print "        Formating title cell" & vbCrLf
    With Selection.Font
        .Bold = True
        .Name = "Arial"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With

    ' Add a border to the bottom of the newly merged cell that will contain the Pivot Table title
    Debug.Print "        Adding border to title call" & vbCrLf
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    ' Add the title of the Pivot Table to the newly merged cell
    Debug.Print "        Adding title to title call" & vbCrLf
    ActiveCell.Value = pivot_title

End Function