VBA code to create a pivot chart on active sheet

boforiamanfo

New Member
Joined
Mar 9, 2019
Messages
1
Hello Everyone,
I am trying to create a VBA code that will automatically create a pivot chart for me on any current active sheet I am on. I recorded a VBA code but it will runs on current sheet and doesn't run on any other sheet that has the same data. The data is the same for all sheets that I want to view. Please help me update below code so that it will run in any sheet. I believe the main issue is coming from the first few codes in BOLD when I tried to debug it but I am not a VBA person.

Option Explicit

Code:
Sub Pivot()
'
' Pivot Macro
'
 
'
    Cells.Select
    Sheets.Add
[B]    ActiveSheet.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R1048576C18", Version:=6).CreatePivotTable TableDestination:= _
        "Sheet2!R1C1", TableName:="PivotTable1", DefaultVersion:=6
    Sheets("Sheet2").Select[/B]
    Cells(1, 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
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=Range("Sheet2!$A$1:$C$18")
    ActiveSheet.Shapes("Chart 1").IncrementLeft 192
    ActiveSheet.Shapes("Chart 1").IncrementTop 14.4
    With ActiveChart.PivotLayout.PivotTable.PivotFields("Type")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveChart.PivotLayout.PivotTable.PivotFields("Buy Date")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveChart.PivotLayout.PivotTable.AddDataField ActiveChart.PivotLayout. _
        PivotTable.PivotFields("Volume"), "Sum of Volume", xlSum
    ActiveChart.PivotLayout.PivotTable.AddDataField ActiveChart.PivotLayout. _
        PivotTable.PivotFields("Volume"), "Sum of Volume2", xlSum
    Application.Left = 170.2
    Application.Top = 13
    Application.Width = 1005.6
    Application.Height = 628.8
    With ActiveChart.PivotLayout.PivotTable.PivotFields("Sum of Volume")
        .Caption = "Max of Volume"
        .Function = xlMax
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Type").CurrentPage = _
        "(All)"
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Type")
        .PivotItems("(blank)").Visible = False
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Type"). _
        EnableMultiplePageItems = True
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 205
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 206
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Select
End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Watch MrExcel Video

Forum statistics

Threads
1,122,363
Messages
5,595,702
Members
414,013
Latest member
tnobbs

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top