"Run-time error '1004': The PivotTable field name is not valid - vba

I am creating an Macro for four Pivot Table in the same spreadsheet and I am getting the following error :
"Run-time error '1004': The PivotTable field name is not valid. To create a PivotTable report you must use data that is organized as a list of labeled columns. If you are changing the name of a PivotTable field, you must type a new name for the field. "
Please help me, I have tried so many times...
Sub Macro4()
'
' Macro4 Macro
'
'
Application.CutCopyMode = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
dataWS = ActiveSheet.Name
dataWS1 = ActiveSheet.Name
Sheets.Add
pivotWS = ActiveSheet.Name
pivotWS1 = ActiveSheet.Name
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"'" & dataWS & "'!A1:AP" & lr, Version:=8).CreatePivotTable TableDestination _
:=pivotWS & "!R3C1", TableName:="PivotTable6", DefaultVersion:=8
Sheets(pivotWS).Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable6")
.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("PivotTable6").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable6").RepeatAllLabels xlRepeatLabels
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable6").PivotFields("FUEL_NAME")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
"PivotTable6").PivotFields("QTY"), "Sum of QTY", xlSum
ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
"PivotTable6").PivotFields("COST_AMT"), "Sum of COST_AMT", xlSum
ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
"PivotTable6").PivotFields("SALES_AMT"), "Sum of SALES_AMT", xlSum
ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
"PivotTable6").PivotFields("MGN "), "Sum of MGN ", xlSum
Range("B4:E6").Select
Selection.Style = "Comma"
Selection.NumberFormat = "_(* #,##0.0_);_(* (#,##0.0);_(* ""-""??_);_(#_)"
Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(#_)"
Range("E4").Select
ActiveSheet.PivotTables("PivotTable6").CalculatedFields.Add "Fuel CPU", _
"= ('MGN ' /QTY )*100", True
ActiveSheet.PivotTables("PivotTable6").PivotFields("Fuel CPU").Orientation = _
xlDataField
Range("F4:F6").Select
Selection.Style = "Comma"
Range("F4").Select
ActiveSheet.PivotTables("PivotTable6").CalculatedFields.Add "Fuel CPL", _
"= ('MGN ' /SALES_AMT )", True
ActiveSheet.PivotTables("PivotTable6").PivotFields("Fuel CPL").Orientation = _
xlDataField
Range("G4:G6").Select
Selection.Style = "Comma"
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0.00%"
Range("A3:G6").Select
ActiveSheet.PivotTables("PivotTable6").RowAxisLayout xlTabularRow
Range("A8").Select
Sheets(dataWS).Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets(pivotWS).PivotTables("PivotTable6").PivotCache. _
CreatePivotTable TableDestination:=pivotWS & "!R9C1", TableName:="PivotTable7" _
, DefaultVersion:=8
Sheets(pivotWS).Select
Cells(9, 1).Select
With ActiveSheet.PivotTables("PivotTable7")
.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("PivotTable7").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable7").RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Sales_Rep")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable7").AddDataField ActiveSheet.PivotTables( _
"PivotTable7").PivotFields("QTY"), "Sum of QTY", xlSum
ActiveSheet.PivotTables("PivotTable7").AddDataField ActiveSheet.PivotTables( _
"PivotTable7").PivotFields("COST_AMT"), "Sum of COST_AMT", xlSum
ActiveSheet.PivotTables("PivotTable7").AddDataField ActiveSheet.PivotTables( _
"PivotTable7").PivotFields("SALES_AMT"), "Sum of SALES_AMT", xlSum
ActiveSheet.PivotTables("PivotTable7").AddDataField ActiveSheet.PivotTables( _
"PivotTable7").PivotFields("MGN "), "Sum of MGN ", xlSum
Range("B10:E16").Select
Selection.Style = "Comma"
Selection.NumberFormat = "_(* #,##0.0_);_(* (#,##0.0);_(* ""-""??_);_(#_)"
Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(#_)"
Range("E10").Select
ActiveSheet.PivotTables("PivotTable7").CalculatedFields.Add "Sales Rep CPU", _
"= ('MGN ' /QTY )*100", True
ActiveSheet.PivotTables("PivotTable7").PivotFields("Sales Rep CPU"). _
Orientation = xlDataField
Range("F10:F16").Select
Selection.Style = "Comma"
Range("F10").Select
ActiveSheet.PivotTables("PivotTable7").CalculatedFields.Add "Sales Rep CPL", _
"= ('MGN ' /SALES_AMT )", True
ActiveSheet.PivotTables("PivotTable7").PivotFields("Sales Rep CPL"). _
Orientation = xlDataField
Range("G10:G16").Select
Selection.Style = "Comma"
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0.00%"
Range("A9:G16").Select
ActiveSheet.PivotTables("PivotTable7").RowAxisLayout xlTabularRow
Range("A17").Select
Sheets(dataWS).Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets(pivotWS).PivotTables("PivotTable7").PivotCache. _
CreatePivotTable TableDestination:=pivotWS & "!R19C1", TableName:="PivotTable8" _
, DefaultVersion:=8
Sheets(pivotWS).Select
Cells(19, 1).Select
With ActiveSheet.PivotTables("PivotTable8")
.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("PivotTable8").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable8").RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables("PivotTable8").PivotFields("VENDOR_ID")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
"PivotTable8").PivotFields("QTY"), "Sum of QTY", xlSum
ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
"PivotTable8").PivotFields("COST_AMT"), "Sum of COST_AMT", xlSum
ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
"PivotTable8").PivotFields("SALES_AMT"), "Sum of SALES_AMT", xlSum
ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
"PivotTable8").PivotFields("MGN "), "Sum of MGN ", xlSum
Range("B20:E22").Select
Selection.Style = "Comma"
Selection.NumberFormat = "_(* #,##0.0_);_(* (#,##0.0);_(* ""-""??_);_(#_)"
Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(#_)"
Range("E20").Select
ActiveSheet.PivotTables("PivotTable8").CalculatedFields.Add "Vendor CPU", _
"= ('MGN ' /QTY )*100", True
ActiveSheet.PivotTables("PivotTable8").PivotFields("Vendor CPU").Orientation = _
xlDataField
Range("F20:F22").Select
Selection.Style = "Comma"
ActiveSheet.PivotTables("PivotTable8").CalculatedFields.Add "Vendor CPL", _
"= ('MGN ' /SALES_AMT )", True
ActiveSheet.PivotTables("PivotTable8").PivotFields("Vendor CPL").Orientation = _
xlDataField
Range("G20:G22").Select
Selection.Style = "Comma"
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0.00%"
Range("A19:G22").Select
ActiveSheet.PivotTables("PivotTable8").RowAxisLayout xlTabularRow
Range("A26").Select
Sheets(dataWS).Select
Range("F10").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sep 2022 MTD!R1C1:R4267C42", Version:=8).CreatePivotTable TableDestination _
:=pivotWS1 & "!R25C1", TableName:="PivotTable9", DefaultVersion:=8
Sheets(pivotWS1).Select
Cells(25, 1).Select
With ActiveSheet.PivotTables("PivotTable9")
.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("PivotTable9").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable9").RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables("PivotTable9").PivotFields("FUEL_NAME")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _
"PivotTable9").PivotFields("QTY"), "Sum of QTY", xlSum
ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _
"PivotTable9").PivotFields("COST_AMT"), "Sum of COST_AMT", xlSum
ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _
"PivotTable9").PivotFields("SALES_AMT"), "Sum of SALES_AMT", xlSum
ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _
"PivotTable9").PivotFields("MGN "), "Sum of MGN ", xlSum
Range("B26:E28").Select
Selection.Style = "Comma"
Selection.NumberFormat = "_(* #,##0.0_);_(* (#,##0.0);_(* ""-""??_);_(#_)"
Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(#_)"
Range("E26").Select
ActiveSheet.PivotTables("PivotTable9").CalculatedFields.Add "Fuel CPU1", _
"= ('MGN ' /QTY )*100", True
ActiveSheet.PivotTables("PivotTable9").PivotFields("Fuel CPU1").Orientation = _
xlDataField
Range("F26:F28").Select
Selection.Style = "Comma"
Range("F25").Select
ActiveSheet.PivotTables("PivotTable9").CalculatedFields.Add "Fuel CPL1", _
"= ('MGN ' /SALES_AMT )", True
ActiveSheet.PivotTables("PivotTable9").PivotFields("Fuel CPL1").Orientation = _
xlDataField
Range("G26:G28").Select
Selection.Style = "Comma"
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0.00%"
Range("A25:G28").Select
ActiveSheet.PivotTables("PivotTable9").RowAxisLayout xlTabularRow
Sheets(dataWS1).Select
End Sub

Related

Searching multiple sheets for a key word then creating a pivot

I have a code to create the pivot table I need, but I want to add the coding to search each tab for a key word and if found highlight the tab and create the pivot table. Start Search for KeyWord = "XXXXX" in first tab and if found highlight and create pivot below, then continue to next tab, loop until done. If keyword not found do nothing and continue to next tab.
Sub Create pivot()
ActiveSheet.Select
With ActiveWorkbook.ActiveSheet.Tab
.Color = 65535
.TintAndShade = 0
End With
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim pc As PivotCache
Set shtSrc = ActiveSheet
Set shtDest = shtSrc.Parent.Sheets.Add()
shtDest.Name = shtSrc.Name & "-Pivot"
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=shtSrc.Range("A1").CurrentRegion)
pc.CreatePivotTable TableDestination:=shtDest.Range("A3"), _
TableName:="PivotTable1"
With shtDest.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
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Suspense?")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("APC LC2 Amount"), "Sum of APC LC2
Amount", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Partner LC2 Amount"), "Sum of Partner LC2
Amount", _
xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("LC2 Amount"), _
"Sum of LC2 amount", xlSum
End Sub

Excel Macro for Pivot Table

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

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:

vba: create pivot table

I have to create a pivot table using vba but i got the following error: "Run-time error '438' Object doesn't support this property or method" about this code: ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R1048576C8", Version:=6).CreatePivotTable TableDestination:= _
pivotTableWs!R1C1, tableName:=tableName, DefaultVersion:=6
here the complete source
Dim tableName As String
Dim pivotTableWs As Worksheet
tableName = "pivotTableName"
Set pivotTableWs = Sheets.Add(after:=Worksheets("Sheet1"))
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R1048576C8", Version:=6).CreatePivotTable TableDestination:= _
pivotTableWs!R1C1, tableName:=tableName, DefaultVersion:=6
Sheets(pivotTableWs).Select
Cells(1, 1).Select
With ActiveSheet.PivotTables(tableName)
.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(tableName).PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables(tableName).RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables(tableName).PivotFields("field1")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables(tableName).AddDataField ActiveSheet.PivotTables( _
tableName).PivotFields("ticketid"), "Count of field1", xlCount
With ActiveSheet.PivotTables(tableName).PivotFields("field2")
.Orientation = xlColumnField
.Position = 1
End With
I create this code using "Developer" tab, selected "Macro register" and i create pivot table manually

I've added 2 Object variables PvtTbl As PivotTable and PvtCache As PivotCache to make the code more dynamic.
Other explanations are inside the code below (as comments).
Code
Option Explicit
Sub AutoPivot()
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Dim PvtTblName As String
Dim pivotTableWs As Worksheet
PvtTblName = "pivotTableName"
' set the worksheet object where we will create the Pivot-Table
Set pivotTableWs = Sheets.Add(after:=Worksheets("Sheet1"))
' set the Pivot Cache (the Range is static)
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Sheet1!R1C1:R1048576C8")
' create a new Pivot Table in the new created sheet
Set PvtTbl = pivotTableWs.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=pivotTableWs.Range("A1"), TableName:=PvtTblName)
' after we set the PvtTbl object, we can easily modifty all it's properties
With PvtTbl
.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
With .PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
.RepeatAllLabels xlRepeatLabels
With .PivotFields("field1")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("ticketid"), "Count of field1", xlCount
With .PivotFields("field2")
.Orientation = xlColumnField
.Position = 1
End With
End With
End Sub

I had the same need for a loop. This is what I used (with comments). It should work with any dataset.
Sub createPivot()
'declare Range variable
Dim dataRange As Range
'get last row and last column in the data sheet
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
'set value for dataRange; this is dynamic and will work for any dataset
Set dataRange = Range(Cells(1, 1), Cells(lastrow, lastcol))
dataRange.Select
'create new WS and insert blank pivot table
Sheets.Add
ActiveSheet.Name = "Pivot"
ActiveWorkbook.PivotCaches.Create(xlDatabase, dataRange, 6).CreatePivotTable Sheets("Pivot").Range("A3"), "PivotTable1", dataRange, 6
' the following 2 blocks are optional
'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Rights Holder")
.Orientation = xlRowField
.Position = 1
End With
'Insert Values fields
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Number of tracks")
.Orientation = xlDataField
.Function = xlSum
End With
End Sub

run time 1004 Error on .Refresh BackgroundQuery

After some updating I have been able to come up with a close to working code. One of the only problems that I am encountering is that the macro is not scraping the data from the last page. For yesterday's data there were 6 pages of data, but the macro is only scraping through page 5. But the weird thing is if i were to scrape data with the same code from 2 days ago, I am able to retrieve the data on all either 7 or 8 pages. I am unsure of why this is happening. Any ideas? Here is the updated code.
'Macro to query Delinquency Status Search for DFB Counties
'Run Monday to pull data from Friday
Sub queryActivityDailyMforFWorking()
Dim nextrow As Integer, i As Long
Dim dates
dates = Date - 1
i = 1
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Do
'i = i + 1
Application.StatusBar = "Processing Page " & i
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
'lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlToLeft).Column + 1
'With ActiveSheet.QueryTables.Add(Connection:= _
'"URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i + county + x & "&status=NS&send_date=" & dates & "&search_1.x=1", _
'Destination:=Range("A" & nextrow))
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=11,%2012,%2013,%2014,%2015,%2016,%2017,%2018,%2019,%2020,%2021,%2022,%2023,%2024,%2025,%2026,%2027,%2028,%2080,%2029,%2030,%2031,%2032,%2033,%2034,%2035,%2036,%2037,%2038,%2039,%2040,%2041,%2042,%2043,%2044,%2045,%2046,%2047,%2048,%2049,%2050,%2051,%2052,%2053,%2054,%2055,%2056,%2057,%2058,%2059,%2079,%2060,%2061,%2062,%2063,%2064,%2067,%2068,%2069,%2065,%2066,%2070,%2071,%2072,%2073,%2078,%2074,%2075,%2076,%2077&status=NS&send_date=" & dates & "&search_1.x=1", _
Destination:=Range("A" & nextrow))
'.Name = _
"2015&search_1.x=40&search_1.y=11&date=on&county_1=AL&lic_num_del=&lic_num_rep=&status=NS&biz_name=&owner_name="
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
'autofit columns
Columns("A:G").Select
Selection.EntireColumn.AutoFit
'check for filter, if not then turn on filter
ActiveSheet.AutoFilterMode = False
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A:G").AutoFilter
End If
i = i + 1
End With
ActiveCell.value = ActiveCell.Value * 2
ActiveCell.Offset(1,0).Select
Loop Until IsEmpty(ActiveCell.Value)
Application.StatusBar = False
'Align text left
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub

My solution (maybe add formatting to bring it back to column A):
Sub QueryDelinquencyTest()
Dim nextrow As Integer, i As Integer
Dim dates
dates = Date - 1
Application.ScreenUpdating = False
Do While i < 25 'this is the page range to be captured.
Application.StatusBar = "Processing Page " & i
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=AL&status=NS&send_date=" & dates & "&search_1.x=1", _
Destination:=Range("A" & nextrow))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=True
End With
i = i + 1
Loop
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub

This is the code that I have so far when declaring a variable for each county.
'Macro to query Delinquency Status Search for DFB Counties
'Run Monday to pull data from Friday
Sub queryActivityDailyMforF()
Dim nextrow As Integer, i As Long
Dim dates
dates = Date - 1
Dim x, county1, county2, county3, county4, county5, county6, county7, county8, county9, county10, county11, county12
county1 = "county_1=16"
county2 = "county_1=21"
county3 = "county_1=23"
county4 = "county_1=32"
county5 = "county_1=36"
county6 = "county_1=41"
county7 = "county_1=46"
county8 = "county_1=53"
county9 = "county_1=54"
county10 = "county_1=57"
county11 = "county_1=60"
county12 = "county_1=66"
'Dim myString
'myString = "No Activity Information Found"
'Dim lastRow As Long
'Dim county
'Dim site As String
'Dim rng As Range
'Dim firstCell As String
'lastRow = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
'If Not rng Is Nothing Then firstCell = rng.Address
'Do Until myString <> lastRow And InStr("&county_1=66", "St. Lucie")
Do
'Do While i < 4
'For i = 1 To lastRow
'Set rng = Sheets("sheet2").Range("A:A").find(What:=Cells(i, 1), LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows)
'Do While lastRow <> myString
Application.StatusBar = "Processing Page " & i
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
'With ActiveSheet.QueryTables.Add(Connection:= _
' "URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=16&county_1=21&county_1=23&county_1=32&county_1=36&county_1=41&county_1=46&county_1=53&county_1=54&county_1=57&county_1=60&county_1=66&status=NS&send_date=" & dates & "&search_1.x=1", _
' Destination:=Range("A" & nextrow))
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & county & x & "&status=NS&send_date=" & dates & "&search_1.x=1", _
Destination:=Range("A" & nextrow))
'.Name = _
"2015&search_1.x=40&search_1.y=11&date=on&county_1=AL&lic_num_del=&lic_num_rep=&status=NS&biz_name=&owner_name="
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
'autofit columns
Columns("A:G").Select
Selection.EntireColumn.AutoFit
'check for filter, if not then turn on filter
ActiveSheet.AutoFilterMode = False
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A:G").AutoFilter
End If
'If Not rng Is Nothing Then
' If rng.Address = firstCell Then Exit Do
' End If
'site = "https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=16&county_1=21&county_1=23&county_1=32&county_1=36&county_1=41&county_1=46&county_1=53&county_1=54&county_1=57&county_1=60&county_1=66&status=NS&send_date=" & dates & "&search_1.x=1"
'county = "&coutny_1=66"
End With
'Next
i = i + 1
Loop Until x = 12
x = x + 1
'Loop Until InStr(site, county) And ActiveCell.Value = myString
'Wend
Application.StatusBar = False
'Align text left
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Next
'Loop
End Sub

VBA - Invalid Procedure when Creating Pivot Tables within a Loop

All,
I call this subfunction within a loop in another subfunction. The loop works well without this sub called. When I call this sub, it works fine once, and then, on the second go, I get a "runtime error 5 - invalid procedure call or argument" here.
I have many sheets, each with a table. I want to summarize each table with a pivot table.
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:=dest, TableName:=pivnm, _
DefaultVersion:=xlPivotTableVersion10
You can see the whole subfunction below.
Sub PIVOT()
Dim pivnm, shtnm, tblnm, dest As String
Application.EnableEvents = False
shtnm = ActiveSheet.Name
tblnm = Range("N2").Value 'I have previously sent the table name to this cell
pivnm = tblnm & " PIVOT"
tblnm = Replace(tblnm, " ", "_")
'The tables are named with underscores, but were stored with spaces
Range("N3") = pivnm
With Range("N3") 'simply wraps the text in the cell
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
dest = shtnm & "!R1C15" 'sets the destination
Sheets(shtnm).Select
Range("C1").Select
'the following was written using the macro recorder, with names replaced by
'variables
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:=dest, TableName:=pivnm, _
DefaultVersion:=xlPivotTableVersion10
Sheets(shtnm).Select
Cells(1, 15).Select
With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
pivnm).PivotFields("Process text"), "Count of Process text", xlCount
ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
pivnm).PivotFields("Column1"), "Sum of Column1", xlSum
With ActiveSheet.PivotTables(pivnm).DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
shtnm = vbNullString 'I tried resetting everything. Didn't work
tblnm = vbNullString
pivnm = vbNullString
dest = vbNullString
End Sub
Please let me know if I have left any information out or if there is anything I can do better!
I was asked to attach the loop from the other function - so here it is...It probably looks ridiculous to anyone but me...
While count3 <= count2
DoEvents
Application.StatusBar = "Updating. Sheet " & (count3) & " of 61 complete."
Sheets("Sheet2").Select
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=2, Criteria1:=Range("O" & CStr(count3)).Value
Range("A1:M" & CStr(count)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.count)
ActiveSheet.Paste
If Range("B2") <> "" Then
ActiveSheet.Name = Range("B2")
tblnm = Range("B2").Value
Sheets(tblnm).Select
Application.StatusBar = "Making Table" & (count3) & " of 61 complete."
While Range("B" & CStr(count4 + 1)) <> ""
count4 = count4 + 1
Wend
Range("N1").Value = count4
DataArea = ("$A$1:$M$" & count4)
DataArea1 = DataArea
ActiveWorkbook.ActiveSheet.ListObjects.Add(xlSrcRange, Range(DataArea1), , xlYes).Name = _
tblnm
ActiveWorkbook.ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:= _
"=*UF_*", Operator:=xlAnd, Criteria2:="<>*Drive*"
ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=8, Criteria1:= _
"<>#VALUE!", Operator:=xlAnd
ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort.SortFields.Add Key _
:=Range("M1:M" & CStr(count4)), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call RhidRow
Columns("A:A").EntireColumn.Hidden = True
Columns("B:B").EntireColumn.Hidden = True
Columns("F:F").EntireColumn.Hidden = True
Columns("G:G").EntireColumn.Hidden = True
Columns("H:H").EntireColumn.Hidden = True
Columns("I:I").EntireColumn.Hidden = True
Columns("J:J").EntireColumn.Hidden = True
Columns("K:K").EntireColumn.Hidden = True
Columns("L:L").EntireColumn.Hidden = True
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
While Range("M" & CStr(count5 + 1)) <> ""
count5 = count5 + 1
Wend
Range("N2") = tblnm
With Range("N2")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Call PIVOT
Else
ActiveSheet.Delete
End If
Range("A1").Select
count3 = count3 + 1
count4 = 2
count6 = 2
Wend

If your sheet names have spaces in them, you need:
dest = "'" & shtnm & "'!R1C15"
This is untested, but as an idea as to passing parameters:
Sub PIVOT(tblnm As String, ws As Worksheet)
Dim pivnm As String
Dim shtnm As String
Dim dest As String
Dim PT As PivotTable
Application.EnableEvents = False
With ws
shtnm = "'" & .Name & "'"
pivnm = tblnm & " PIVOT"
tblnm = Replace(tblnm, " ", "_")
'The tables are named with underscores, but were stored with spaces
With .Range("N3")
.Value = pivnm
'simply wraps the text in the cell
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End With
dest = shtnm & "!R1C15" 'sets the destination
'the following was written using the macro recorder, with names replaced by
'variables
Set PT = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblnm, Version:=xlPivotTableVersion10).CreatePivotTable( _
TableDestination:=dest, TableName:=pivnm, _
DefaultVersion:=xlPivotTableVersion10)
With PT
With .PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("Process text"), "Count of Process text", xlCount
.AddDataField .PivotFields("Column1"), "Sum of Column1", xlSum
With .DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
End With
End Sub
and the calling code would use something like:
Call PIVOT(tblnm, wks)
where wks is a Worksheet variable set to whichever sheet has the data.