Error recording macro to create Pivot Grid

70 views Asked by At

I'm seeing this error: Run-time error '1004' Application-defined or object defined error Error.

I've looked over several post but can't figure it out.

The error is on this line when creating the ActiveWorkbook.PivotCaches.Create(). Seems like it is on the SourceData part.

Sub Macro10()
'
' Macro10 Macro
'

'
    Columns("A:I").Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "FoodSales!R1C1:R1048576C9", Version:=7).CreatePivotTable TableDestination _
        :="Sheet16!R3C1", TableName:="PivotTable8", DefaultVersion:=7
    Sheets("Sheet16").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable8")
        .ColumnGrand = True

I'm trying to make the following pivot table:

Row - City Column - Product Data - Total Price

What am I doing wrong?

Here is the full code:

Sub Macro10()
'
' Macro10 Macro
'

'
    Columns("A:I").Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "FoodSales!R1C1:R1048576C9", Version:=7).CreatePivotTable TableDestination _
        :="Sheet16!R3C1", TableName:="PivotTable8", DefaultVersion:=7
    Sheets("Sheet16").Select
    Cells(3, 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("City")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("Product")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
        "PivotTable8").PivotFields("TotalPrice"), "Sum of TotalPrice", xlSum
End Sub
1

There are 1 answers

0
ttest2727 On

I think I fixed it:

Instead of taking the results from recording the macro, I found this article and was able to update the top portion where the PivotCaches.Create() is created to make it more dynamic I guess.

I can add this code to the top and then the rest of the recorded macro works perfect!

Update problem area code:

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTableMain").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTableMain"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTableMain")
Set DSheet = Worksheets("FoodSales")
    
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
    
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTableBraves")

Here is the full result:

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+B
'
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTableMain").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTableMain"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTableMain")
Set DSheet = Worksheets("FoodSales")
    
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
    
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTableBraves")

    With ActiveSheet.PivotTables("PivotTableBraves")
        .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("PivotTableBraves").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTableBraves").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTableBraves").PivotFields("Category")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTableBraves").PivotFields("City")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTableBraves").AddDataField ActiveSheet.PivotTables( _
        "PivotTableBraves").PivotFields("TotalPrice"), "Sum of TotalPrice", xlSum
    Range("H19").Select
    ActiveWorkbook.Save
    Range("B5:G10").Select
    Selection.Style = "Currency"
    Range("E8").Select
    ActiveWorkbook.Save
End Sub