everyone.
I was using the Sub ClearColumns to clear all field in the column area from a Pivot Table.
Sub ClearColumns()
Dim PT As PivotTable, PF As PivotField
Set PT = ActiveSheet.PivotTables("Tb1")
With PT
For Each PF In .ColumnFields
PF.Orientation = xlHidden
Next PF
End With
Set PT = Nothing
End Sub
But now that i started using PowerPivot, the code doesnt Work. I think the fields are no longer PivotField, but CubeFields. It Is possible to make the same macro above, but for Cubefields? I tried different things, but i cant make it work.
Sub ClearColumnsPP()
Dim PT As PivotTable, PF As CubeFields
Dim strSource As String
Dim strName As String
Set PT = ActiveSheet.PivotTables("Tb1")
With PT
For Each PF In .ColumnFields
strSource = PF.SourceName
strName = PF.Name
PF(strSource, strName).Orientation = xlHidden
Next PF
End With
Set PT = Nothing
End Sub
Thanks!!
You need to check the orientation of the CubeField, and only set to hidden if it is a Column field:
Sub foo()
Dim pt As PivotTable
Dim cf As CubeField
Set pt = ActiveSheet.PivotTables("Tb1")
For Each cf In pt.CubeFields
If cf.Orientation = xlColumnField Then cf.Orientation = xlHidden
Next cf
End Sub
Related
I'm using a small macro to add and delete Data field in pivotable.
I have buttom assigned to Buttom, by pushining the buton I can call the field but by pushing
twice it should be hidden, but it doesnt happend. One of the reason, pointed to
Set myshape = ActiveSheet.Shapes(Application.Caller). Maybe I have another problems with code.
Here's the code:
Sub Base_Salary()
Dim pt As PivotTable
Dim pf As PivotField
Dim sField As String
Dim myshape As Shape
Set pt = ActiveSheet.PivotTables(1)
Set myshape = ActiveSheet.Shapes(Application.Caller)
sField = myshape.TextFrame.Characters.Text
If pt.PivotFields(sField).Orientation = xlDataField Then
pt.PivotFields(sField).Orientation = xlHidden
myshape.Fill.ForeColor.Brightness = 0.5
Else
pt.PivotFields(sField).Orientation = xlDataField
myshape.Fill.ForeColor.Brightness = 0
End If
End Sub
I am trying to filter a pivot table based on the filter of another pivot table on a different sheet with a different data source.
I have two sheets (Main and Size Actual - Style) and want to filter by "Style". The Main sheet is where I want to choose the styles to filter by and from there I want to have the other sheet update with those selected styles filtered (would help if the filtering occurred with a button). I have changed some code to account for the field (Style) that I want to filter for. Right now I have the Main sheet pivot table resetting to show all values when a filter on style is selected on Size Actual - Style. I need that to be switched and instead of clearing the filter I want it to update with the selected styles from the filter.
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
On Error Resume Next
Dim wsMain As Worksheet
Dim ws As Worksheet
Dim ptMain As PivotTable
Dim pt As PivotTable
Dim pfMain As PivotField
Dim pf As PivotField
Dim pi As PivotItem
Dim bMI As Boolean
On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each pfMain In ptMain.PageFields
bMI = pfMain.EnableMultiplePageItems
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then
pt.ManualUpdate = True
Set pf = pt.PivotFields("Style")
bMI = pfMain.EnableMultiplePageItems
With pf
.ClearAllFilters
Select Case bMI
Case False
.CurrentPage = pfMain.CurrentPage.Value
Case True
.CurrentPage = "(All)"
For Each pi In pfMain.PivotItems
.PivotItems("Style").Visible =
pi.Visible
Next pi
.EnableMultiplePageItems = bMI
End Select
End With
bMI = False
Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt
Next ws
Next pfMain
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I am trying to have the filter on the second sheet update its filter based on the selection on the first sheets style filter.
I have this VBA marco which changes all the field values to Product.
Dim pt As PivotTable
Dim pf As PivotField
Dim ws As Worksheet
Set ws = ActiveSheet
Set pt = ws.PivotTables(1)
Application.ScreenUpdating = False
pt.ManualUpdate = True
For Each pf In pt.DataFields
pf.Function = xlProduct
Next pf
pt.ManualUpdate = False
Application.ScreenUpdating = True
Set pf = Nothing
Set pt = Nothing
Set ws = Nothing
End Sub
When when I try changing xlProduct to xlCount.Numbers, the code doesn't work. Any idea how to fix this?
xlCountNums is the proper function.
https://www.thespreadsheetguru.com/blog/2014/8/12/quickly-change-pivot-table-field-calculation-from-count-to-sum
My goal is to filter PivotTable3 based on the active cell selected on the project dashboard sheet. The range for NewCat is set to "U10" but I would like any active cell selected to be the driver for the filter.
NewCat = Worksheets("Project Dash").Range("U10").Value
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("U8:U37")) Is Nothing Then Exit Sub
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
Set pt = Worksheets("mPIVOTS").PivotTables("PivotTable3")
Set Field = pt.PivotFields("Project")
NewCat = Worksheets("Project Dash").Range("U10").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With
End Sub
I'm not sure if I understand it correctly, but how about changing this line:
NewCat = Worksheets("Project Dash").Range("U10").Value
To this:
NewCat = Target.Value
I currently have some VBA code that essentially replaces a Filter Field in a PivotTable, but because the current excel spreadsheet has hundreds of PivotTables, I'm reaching to a point where the VBA doesn't work with Procedure too large.
Problem is I don't know how to decrease the repetition - any assistance would be certainly appreciated.
Code below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("P6:P7")) Is Nothing Then Exit Sub
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable8")
Set Field = pt.PivotFields("Company Code")
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
End With
Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable6")
Set Field = pt.PivotFields("Company Code")
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
End With
Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable20")
Set Field = pt.PivotFields("Company Code")
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
End With
Set pt = Worksheets("Pivot Booking").PivotTables("PivotTable7")
Set Field = pt.PivotFields("Company Code")
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
'Keeps on repeating for about 200 more PivotTables in Various Sheets
End With
End Sub
If you want to change all the pivot tables on that sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("P6:P7")) Is Nothing Then Exit Sub
Dim pt As PivotTable, NewCat As String, s
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
For Each s In Array("Pivot Booking", "Pivot Transaction", _
"Pivot Level Segment")
For Each pt In Worksheets(s).PivotTables
With pt.PivotFields("Company Code")
.ClearAllFilters
.CurrentPage = NewCat
End With
Next pt
Next s
End Sub
Thank you all - the complete code that has worked is as per below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("P6:P7")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo ErrorHandler
Dim pt As PivotTable, NewCat As String, s
NewCat = Worksheets("Trending&Benchmarking").Range("P6").Value
For Each s In Array("Pivot Booking", "Pivot Transaction", "Pivot Level Segment", "Pivot YoY TransactionGraph")
For Each pt In Worksheets(s).PivotTables
With pt.PivotFields("Company Code")
.ClearAllFilters
.CurrentPage = NewCat
End With
Next pt
Next s
ErrorHandler:
Debug.Print Err.Number & vbNewLine & Err.Description
Resume ErrorExit
ErrorExit:
Application.EnableEvents = True
Exit Sub
End Sub