How do I position my pivot table filters above each other using VBA?

Question

Basically, I have multiple tabs I am putting together, each with multiple pivots, where each pivot has multiple filters built in. These need to be visible to confirm the data you are seeing, since non-developers wouldn't know, how to access or understand VBA code.

What I want: Pivot table filters to be over each other in a list form:

What I currently get:

Here is a simplified version of the code...please let me know if there is a better way of doing this!

I tried using the Record Macro button in excel and format everything as I wanted to see, but once I actually run the macro, the filters are side by side rather than on top of each other.

Sub Macro5()
    Columns("A:A").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False


    Dim dataname As String
    Dim datasheetname As String
    Dim pivotsheetname As String

    dataname = ActiveSheet.ListObjects(1).Name
    datasheetname = ActiveSheet.Name
    pivotsheetname = datasheetname & " Pivot"


    Sheets.Add

    ActiveSheet.Name = pivotsheetname

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        dataname, Version:=6).CreatePivotTable TableDestination:= _
        "'" & pivotsheetname & "'!R3C1", TableName:="PivotTable15", 
    DefaultVersion:=6
    Sheets(pivotsheetname).Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable15")
        .ColumnGrand = False
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = False
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 3
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("PivotTable15").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable15").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable15").PivotFields("Billable?")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable15").PivotFields("Billed")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable15").PivotFields("Amount")
    enter code here       .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable15").AddDataField 
    ActiveSheet.PivotTables( _
        "PivotTable15").PivotFields("Qty"), "Sum of Qty", xlSum
End Sub

Answer 1

The order of the filter fields is defined by the parameter PageFieldOrder, which can be:

• xlOverThenDown (= 2, your previous result)
• xlDownThenOver (= 1, your desired result)

I optimized your code additionally:

• normally, it i not necessary to select or activate anything
• I added two variables to reference the pivotcache and the pivottable objects
• the datafield can be added similar to the other pivotfields, but their name has to be set afterwards

---

Sub GenerateNewPivottable()
    Dim datasheetname As String
    Dim dataname As String
    Dim pivotsheetname As String
    Dim pc As PivotCache
    Dim pt As PivotTable

    Application.CutCopyMode = False

    dataname = ActiveSheet.ListObjects(1).Name
    datasheetname = ActiveSheet.Name
    pivotsheetname = datasheetname & " Pivot"

    Sheets.Add
    ActiveSheet.Name = pivotsheetname

    Set pc = ActiveWorkbook.PivotCaches.Create( _
        SourceType:=xlDatabase, _
        SourceData:=dataname)
    With pc
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault ' better: xlMissingItemsNone
    End With

    Set pt = pc.CreatePivotTable( _
        TableDestination:="'" & pivotsheetname & "'!R3C1", _
        TableName:="PivotTable15")

    With pt
        .ColumnGrand = False
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = XlOrder.xlDownThenOver
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = False
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 3
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlTabularRow
        .RepeatAllLabels xlRepeatLabels
    End With


    With pt.PivotFields("Billable?")
        .Orientation = xlPageField
        .Position = 1
    End With
    With pt.PivotFields("Billed")
        .Orientation = xlPageField
        .Position = 1
    End With
    With pt.PivotFields("Amount")
        .Orientation = xlPageField
        .Position = 1
    End With

    With pt.PivotFields("Qty")
        .Orientation = xlDataField
        .Function = xlSum
        .Name = "Sum of Qty"
    End With

End Sub