Excel Macro for Pivot Table - vba

Question

So I created a macro to create a basic pivot table in excel. I recorded the macro and have 5 filters. When running the macro the format gets messed up and the filters are listed across columns instead of listed vertically. How do I get the filters listed vertically?
Incorrect Format Image
Correct Format Image
Range("Table1[[#Headers],[Installation]]").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Table1", Version:=6).CreatePivotTable TableDestination:="Sheet1!R3C1", _
TableName:="PivotTable1", DefaultVersion:=6
Sheets("Sheet1").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
End With
With ActiveSheet.PivotTables("PivotTable1").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Accountable" & Chr(10) & "Organization")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Installation/Site/Proponent Submittal")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("SRP")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("New Submitter")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Submittal Data Received")
.Orientation = xlPageField
.Position = 1
End With

Answer 1

I don't know if you have an actual Excel table as source. If you did you could do something like as follows (check field name spellings and also I assumed row field was called Base)
Option Explicit
Public Sub CreatePivotFromTable()
Dim table As ListObject
Set table = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1")
' ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$R$16"), , xlYes).Name = _
' "Table1" ''<======== code for creating table instead if not already present
Sheets.Add
With ActiveSheet
Dim pvt As PivotTable
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
table, Version:=6).CreatePivotTable TableDestination:=.Range("A3"), _
TableName:="PivotTable1", DefaultVersion:=6 'version 6 information may need removing
Set pvt = .PivotTables("PivotTable1")
Dim pvtPageFieldArr()
''Note check spellings of fields below and base is an placeholder name for the field containing Ten Nat Guard etc
pvtPageFieldArr = Array("Accountable Organisation", "Installation/Proponent Submittal", "SRP", "New Submitter", _
"Submittal Data Received", "Base")
Dim fieldName As Long
For fieldName = LBound(pvtPageFieldArr) To UBound(pvtPageFieldArr)
With pvt.PivotFields(pvtPageFieldArr(fieldName))
.Orientation = xlPageField
.Position = 1
End With
Next fieldName
Dim pvtRowFieldArr()
''Note check spellings of fields below and base is an placeholder name for the field containing Ten Nat Guard etc
pvtRowFieldArr = Array("Base")
For fieldName = LBound(pvtRowFieldArr) To UBound(pvtRowFieldArr)
With pvt.PivotFields(pvtRowFieldArr(fieldName))
.Orientation = xlRowField
.Position = 1
End With
Next fieldName
Dim dataFieldArr()
dataFieldArr = Array("Layers Submitted", "New Schema-Compliant Layers", "Schema-Compliant Layers with changes", _
"Schema-Compliant Layers with NO changes", "Empty. Non Compliant. Non-SRP Proponent Submitted by SRP", _
"Layers in Repository", "Repository Layers Checked for QAP Compliance", "# of Repository Layers Checked for QAP Compliance", _
"Total # of QAP Checks Performed", "Total # of QAP Errors Found", "Roll-Up QAP Compliance Total % Accuracy")
Dim currField As String
For fieldName = LBound(dataFieldArr) To UBound(dataFieldArr)
currField = dataFieldArr(fieldName)
pvt.AddDataField pvt.PivotFields(currField), "Sum of " & currField, xlSum
Next fieldName
End With
End Sub
This is where sheet 1 has a table (Created with Ctrl + T when a populated cell in range is selected)
Sheet 1 input:
New sheet output: