I have a pivot table macro that two row fields and one value column. I am trying to figure out how I could right an If Statement that would detect if there is no number in the "Adjustment Amount" the detail will be closed in the column called "ledger". Below is the code I have:
Sub MakeAPivotTable()
Dim pt As pivotTable 'Creates pivot table
Dim pc As PivotCache 'Pivot Cache
Dim pf As PivotField 'Pivot Field
Dim pi As PivotItem
Dim PRange As Range 'Source data range
Dim lastRow As Long 'Last Row of Report even if it changes
Dim lastCol As Long 'Last Column of Report even if it changes
Dim DSheet As Worksheet 'Claiming "Report" sheet as data sheet
Dim PSheet As Worksheet 'Claiming what is pivot sheet for this macro
Dim ptType As String
Dim ADJ As Range
'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Metrics").Delete
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Metrics"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Metrics")
Set DSheet = Worksheets("Report")
With ActiveWorkbook.Sheets("Metrics").Tab
.Color = 4555
.TintAndShade = 0
End With
'Defining Data Range. Taking the first cell of the data table and select uptp the last row and then up to the last column
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)
'Create pivot cache. Defines Pivot Cache by using Data source and defines the cell address in the new worksheet to insert pivot table
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), TableName:="Accrual")
'Insert Pivot Table
Set pt = pc.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="Accrual")
'Putting Row Fields in
With ActiveSheet.PivotTables("Accrual").PivotFields("Ledger Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Accrual").PivotFields("CC")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("Accrual").CompactLayoutRowHeader = "Ledger"
'Putting Values Field in
ActiveSheet.PivotTables("Accrual").AddDataField ActiveSheet.PivotTables( _
"Accrual").PivotFields("Adjustment Amt"), "Sum of Adjustment Amt", _
xlSum
ActiveSheet.PivotTables("Accrual").DataPivotField.PivotItems( _
"Sum of Adjustment Amt").Caption = "Adjustment Amount"
With ActiveSheet.PivotTables("Accrual").PivotFields("Adjustment Amount")
.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(#_)"
End With
And this is what I thought would work:
For Each ADJ In Worksheets("Metrics").Range("C3:C100")
If ADJ = "" Then
ActiveSheet.PivotTables("Accrual").PivotFields("Ledger Name").Selection.ShowDetail = False
End If
Next
Related
I have been trying for hours now to create a pivot table from VBA. I've tried various codes but i keep getting errors. The following code does not create a pivot table it only creates a new sheet. I have a sheet called "Base" where all my data is. It has 18288 rows and 13 columns with data. Can anyone help me with why the code isn't working for me
Sub pivottable()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivottable
Dim PRange As range
Dim LastRow As Long
Dim LastCol As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Base")
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:="PivotTable")
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")
Sheets("PivotTable").Select
With ActiveSheet.PivotTables("PivotTable").PivotFields("FACULTY_ID")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("PROGRAM_TYPE_NAME")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables( _
"PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum
End Sub
This might work for you:
Sub pivottable()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivottable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim new_sheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Application.DisplayAlerts = True
On Error GoTo 0
new_sheet_name = "PivotTable"
pivot_table_name = "pivot_name_here"
Set new_sheet = Sheets.Add(Before:=ActiveSheet)
With new_sheet
.Name = new_sheet_name
End With
Set PSheet = new_sheet
Set DSheet = Worksheets("Base")
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.Address(, , xlR1C1))
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1).Address(, , xlR1C1), TableName:=pivot_table_name)
With PTable.PivotFields("FACULTY_ID")
.Orientation = xlRowField
.Position = 1
End With
With PTable.PivotFields("PROGRAM_TYPE_NAME")
.Orientation = xlRowField
.Position = 2
End With
With PTable
.AddDataField ActiveSheet.PivotTables( _
"PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum
End With
End Sub
Looks like this link is cold, but in case someone else wants to do this, here's code I adapted from other answers (StackOverflow and elsewhere) to create several Pivot Tables. This code receives a Global Variable from above that is an array with 7 salesman's names. The code:
Finds the range of the data on each "salesman's" sheet.
Creates a Pivot Table Cache with the salesman's name (this was the key to getting it to work).
Creates a Pivot table with the salesman's name.
Labels and sorts the Pivot Table.
Moves on to the next Sheet.
Sub Pivot_Maker() 'adapted from the internet. I added the arrays tho - AAI
'as of 11/26/2019
Dim FinalRow As Long
Dim DataSheet As String
Dim PvtCache As PivotCache
Dim PvtTbl(7) As PivotTable
Dim DataRng As Range
Dim TableDest As Range
i = 0
Do While i < NumSalesPeeps
Sheets(Salesman(i)).Select
Range("A1").Select
If IsEmpty(Range("A30")) Then GoTo No_Data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
DataSheet = ActiveSheet.Name
PvtTblName = ActiveSheet.Name & "pvt"
' set data range for Pivot Table
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 10)) ' conversion of R1C1:R & FinalRow & C8
' set range for Pivot table placement
Set TableDest = Sheets(DataSheet).Cells(1, 12) ' conversion of R1C9
Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng)
' this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables(PvtTblName) ' check if PvtTblName Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If PvtTbl(i) Is Nothing Then ' PvtTblName doesn't exist >> create it
' create a new Pivot Table in PvtTblName sheet
Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:=PvtTblName)
With PvtTbl(i).PivotFields("Account")
.Orientation = xlColumnField
.Position = 1
End With
With PvtTbl(i).PivotFields("Name")
.Orientation = xlRowField
.Position = 1
End With
PvtTbl(i).AddDataField ActiveSheet.PivotTables( _
PvtTblName).PivotFields("Amount"), "Sum of Amount", xlSum
Else
' just refresh the Pivot cache with the updated Range
PvtTbl(i).ChangePivotCache PvtCache
PvtTbl(i).RefreshTable
End If
With ActiveSheet.PivotTables(PvtTblName).PivotFields("Sum of Amount")
.NumberFormat = "$#,##0"
End With
No_Data:
i = i + 1
Loop
End Sub
The VBA code I have below is trying to create a Pivot Table based on data in "Sheet2", adding a new sheet "Pivot Table" and creating a Pivot Table on this sheet.
However the code is executing without error, just no table appears on the new sheet "Pivot Table" and I cannot see why.
Also the data on Sheet2 for the PT currently begins in column B, not sure if this is having an effect.
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow1 As Long
Dim LastCol As Long
'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Sheet2")
'Define Data Range
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)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="MilestonePivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="MilestonePivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("MilestonePivotTable").PivotFields("Resource Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("MilestonePivotTable").PivotFields("Deliverable")
.Orientation = xlRowField
.Position = 2
End With
'Insert Column Fields
With ActiveSheet.PivotTables("MilestonePivotTable").PivotFields("Milestone Date")
.Orientation = xlColumnField
.Position = 1
End With
Only semi-tested (due to only having dummy data) but I believe the following will fix all your errors:
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
'LastRow was not declared
Dim LastRow As Long
'LastRow1 is not used
'Dim LastRow1 As Long
Dim LastCol As Long
'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
'Switch off error "masking" once you don't need it
On Error GoTo 0
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Sheet2")
'Define Data Range
'a) Base last row on column B if you don't have data in column A
'b) Use "DSheet.Rows.Count" and "DSheet.Columns.Count" - although not strictly
' necessary in this situation, it is a good practice to get into
LastRow = DSheet.Cells(DSheet.Rows.Count, "B").End(xlUp).Row
LastCol = DSheet.Cells(1, Dsheet.Columns.Count).End(xlToLeft).Column
'Don't include column A in your data range
Set PRange = DSheet.Cells(1, "B").Resize(LastRow, LastCol - 1)
'Define Pivot Cache (not pivot table)
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange)
'Set PCache = ActiveWorkbook.PivotCaches.Create _
'(SourceType:=xlDatabase, SourceData:=PRange). _
'CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
'TableName:="MilestonePivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="MilestonePivotTable")
'Use PSheet instead of ActiveSheet in all the following statements
'In fact, because the PTable object exists, we can just use it
'Insert Row Fields
'With AciveSheet.PivotTables("MilestonePivotTable").PivotFields("Resource Name")
'With PSheet.PivotTables("MilestonePivotTable").PivotFields("Resource Name")
With PTable.PivotFields("Resource Name")
.Orientation = xlRowField
.Position = 1
End With
With PTable.PivotFields("Deliverable")
.Orientation = xlRowField
.Position = 2
End With
'Insert Column Fields
With PTable.PivotFields("Milestone Date")
.Orientation = xlColumnField
.Position = 1
End With
I am trying to write some VBA that will build a pivot table in a new tab. When I run the code I am getting the Type Mismatch error when creating the PivotTable Cache.
The code is below, any help would be appreciated...hopefully a fresh look at it can spot what I am missing
Sub makeAPivotTable()
Dim sSheet, sSheet2 As Worksheet 'sSheet is where the data is, sSheet2 is where the pivot will be built
Dim cCache As PivotCache
Dim ptTable As PivotTable
Dim rRange As Range
Dim rLastRow, cLastColumn As Long
' Insert the new sheet for the pivot table to reside
Application.DisplayAlerts = False
Sheets.Add Before:=ActiveSheet
ActiveSheet.name = "PivotTable"
Application.DisplayAlerts = True
Set sSheet2 = Worksheets("PivotTable")
Set sSheet = Worksheets("Interactions db")
' define the range (the data that you want to put into the pivot table
rLastRow = sSheet.Cells(Rows.Count, 1).End(xlUp).Row
cLastColumn = sSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set rRange = sSheet.Cells(1, 1).Resize(rLastRow, cLastColumn)
' create the cache for the pivot table
Set cCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=rRange). _
CreatePivotTable(TableDestination:=sSheet2.Cells(2, 2), _
TableName:="SalesPivotTable")
' insert the blank table
Set ptTable = cCache.CreatePivotTable _
(TableDestination:=sSheet2.Cells(1, 1), TableName:="SalesPivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("customer")
.Orientation = xlRowField
.Position = 1
End With
'Insert Column Fields
'With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Interaction Type")
'.Orientation = xlColumnField
'.Position = 1
'End With
'Insert Data Field
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("interactionType")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.name = "Person "
End With
' do some formatting
End Sub
Try the code below (explanations inside the code as comments)
Option Explicit
Sub makeAPivotTable()
Dim sSheet As Worksheet, sSheet2 As Worksheet ' sSheet is where the data is, sSheet2 is where the pivot will be built
Dim cCache As PivotCache
Dim ptTable As PivotTable
Dim rRange As Range
Dim rLastRow As Long, cLastColumn As Long ' need to define each one as Long, otherwise the first one is Variant
' Insert the new sheet for the pivot table to reside
Application.DisplayAlerts = False
' 2 lines below are shorter version to create a new sheet,
' assign it to sSheet2 , and name it "PivotTable"
On Error Resume Next
Set sSheet2 = Sheets("PivotTable") '<-- try to set the Sheet (already created in past code runs)
On Error GoTo 0
If sSheet2 Is Nothing Then '<-- sheet does not exist yet >> Add it
Set sSheet2 = Sheets.Add(Before:=ActiveSheet)
sSheet2.Name = "PivotTable"
End If
Application.DisplayAlerts = True
Set sSheet = Worksheets("Interactions db")
' define the range (the data that you want to put into the pivot table
With sSheet
rLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
cLastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rRange = .Cells(1, 1).Resize(rLastRow, cLastColumn)
End With
' create the cache for the pivot table ***** THIS is the CORRECT Syntax
Set cCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rRange)
' CREATE a NEW Pivot Table in sSheet2 sheet
Set ptTable = sSheet2.PivotTables.Add(PivotCache:=cCache, TableDestination:=sSheet2.Range("A1"), TableName:="SalesPivotTable")
With ptTable
'Insert Row Fields
With .PivotFields("customer")
.Orientation = xlRowField
.Position = 1
End With
'Insert Column Fields
'With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Interaction Type")
'.Orientation = xlColumnField
'.Position = 1
'End With
'Insert Data Field
With .PivotFields("interactionType")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "Person "
End With
' do some formatting
End With
End Sub
Requesting help I am currently working on a macro based pivot table where we have 5 columns in Report filter.
What I am looking for is vba code for these five filer, it should show the value if the filter contains a single value else should remain as (All).
Currently I am using the following code for pivot filer:
Sub InsertPivotTable()
'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Pivot").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Pivot"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Pivot")
Set DSheet = Worksheets("Report")
'Define Data Range
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)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), _
TableName:="ADT_PivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="ADT_PivotTable")
'Insert Reportfilter Fields
With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("Resp Bus Partn ID")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("ADT-File ID")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("UWY")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("SCoB - Acc")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("Curr")
.Orientation = xlPageField
.Position = 1
End With
End Sub
The answer and code are a little long, but I've added a few "Bonuses" for you, so you'll find it very useful :)
First, there is no need to delete "Pivot" sheet and re-create it just to update the PivotTable named "ADT_PivotTable", you can just update the PivotCache with the updated SourceData, and afterwards refresh the PivotTable with the updated PivotCache.
Second, I’ve added a second Sub, that check for every PivotField passed to it how many PivotItems it has, if there’s only one PivotItem then display it in the Filter, Otherwise show "All".
Sub InsertPivotTable Code
Option Explicit
Sub InsertPivotTable()
'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Set PSheet = Worksheets("Pivot")
On Error GoTo 0
If PSheet Is Nothing Then ' if "Pivot" sheet doesn't exist
Set PSheet = Sheets.Add(Before:=ActiveSheet)
PSheet.Name = "Pivot"
End If
Application.DisplayAlerts = True
Set DSheet = Worksheets("Report")
'Define Data Range
With DSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set PRange = .Range("A1").Resize(LastRow, LastCol) ' set data range for Pivot Table
End With
' Set the Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
On Error Resume Next
Set PTable = PSheet.PivotTables("ADT_PivotTable") ' Set the Pivot Table if already exists from previous code runs
On Error GoTo 0
If PTable Is Nothing Then ' <-- Pivot Table still doesn't exist >> create it for the first time
' create a new Pivot Table in "Pivot" sheet
Set PTable = PSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=PSheet.Range("A1"), TableName:="ADT_PivotTable")
With PTable
'Insert Reportfilter Fields
With .PivotFields("Resp Bus Partn ID")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("ADT-File ID")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("UWY")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("SCoB - Acc")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("Curr")
.Orientation = xlPageField
.Position = 1
End With
End With
Else
' just refresh the Pivot cache with the updated Range
PTable.ChangePivotCache PCache
PTable.RefreshTable
End If
' modify the Filter default view for each of the Pivot Fields below
With PTable
SelectFilterSingleValue .PivotFields("Resp Bus Partn ID")
SelectFilterSingleValue .PivotFields("ADT-File ID")
SelectFilterSingleValue .PivotFields("UWY")
SelectFilterSingleValue .PivotFields("SCoB - Acc")
SelectFilterSingleValue .PivotFields("Curr")
End With
End Sub
Sub SelectFilterSingleValue Code
Sub SelectFilterSingleValue(ptFld As PivotField)
Dim PTItm As PivotItem
Dim Count As Long
With ptFld
.EnableMultiplePageItems = True
For Each PTItm In .PivotItems
If PTItm.Name <> "(blank)" Then
PTItm.Visible = True
Count = Count + 1
Else
PTItm.Visible = False
End If
Next PTItm
If Count > 1 Then
.ClearAllFilters
End If
End With
End Sub
I am currently using VBA in excel 2010 and have created a pivot table that I would like to format based on certain things. I am trying to get the +/- buttons removed from the table using
ActiveSheet.PivotTables("HoldersPivotTable").ShowDrillIndicators = False
but that isn't working for some reason.
Help would be much appreciated!
Sub PivotTable_Creation_And_Formatting()
'PURPOSE: Creates a brand new Pivot table on a new worksheet from data in the ActiveSheet
Sheets("Sheet2").Select
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim pf As PivotField
Dim StartPvt As String
Dim SrcData As String
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
'Determine the data range you want to pivot
SrcData = ActiveSheet.Name & "!" & Range(Cells(1, "A"), Cells(LastRow, "E")).Address
'Create a new worksheet
Set sht = Sheets("HOLDERS (CORP)")
'Where do you want Pivot Table to start?
StartPvt = sht.Range("A1").Address
'Create Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
'Create Pivot table from Pivot Cache
Set pvt = pvtCache.CreatePivotTable(TableDestination:=sht.Range(StartPvt), _
TableName:="HoldersPivotTable")
pvt.PivotFields("SECURITY SHORT DESCRIPTION").Orientation = xlRowField
'Add item to the Row Labels
pvt.PivotFields("HOLDERS").Orientation = xlRowField
'Add item to the Row Labels
pvt.PivotFields("POSITION").Orientation = xlRowField
'Add item to the Row Labels
pvt.PivotFields("LATEST CHANGE").Orientation = xlRowField
'Add item to the Row Labels
pvt.PivotFields("FILE DT").Orientation = xlRowField
pvt.ColumnGrand = False
pvt.RowGrand = False
'Show in Tabular Form
pvt.RowAxisLayout xlTabularRow
For Each pf In pvt.PivotFields
pf.Subtotals(1) = True
pf.Subtotals(1) = False
Next pf
Sheets("HOLDERS (CORP)").Select
Columns("A:E").Select
Selection.Columns.AutoFit
Columns("C:C").ColumnWidth = 13.43
Columns("A:E").HorizontalAlignment = xlLeft
Columns("B:E").Interior.Color = RGB(141, 180, 226)
Range("A1").Interior.Color = RGB(141, 180, 226)
With Range("A1:E1").Borders
.LineStyle = xlContinuous
.Weight = xlMedium
End With
ActiveSheet.PivotTables("HoldersPivotTable").ShowDrillIndicators = False
Range("B1").Select
End Sub
Change the code to read:
ActiveSheet.PivotTables("HoldersPivotTable").ShowDrillIndicators = False
ActiveSheet.PivotTables("HoldersPivotTable").PivotCache.Refresh
This will re-display the pivot without the drilldown indicators. You have to refresh the pivot to get the changes to appear.
If it still does not work, then check for a
Application.ScreenUpdating = False
that doesn't have the corresponding
Application.ScreenUpdating = True