Excel VBA: clear items in pivot table - vba

I am new to VBA...
I am trying to write a macro that will clear all the selections within a pivot table filter named "Product Family" and select only the item whose name is contained in cell "B33". I am referencing the pivot table in one sheet "sheet8" and trying to change a graph on "Dashboard".
Here is the code...
Sub thisisalsotemp()
'
' thisisalsotemp Macro
'
'
Sheets("Dashboard").Select
ActiveSheet.ChartObjects("Chart 1").Activate
Sheet8.PivotTables("capbylp").PivotFields("Product Family").PivotFields.ClearAllFilters
With Sheet8.PivotTables("capbylp").PivotFields("Product Family")
.PivotItems(Range("B33")).Visible = True
End With
End Sub
The error is in the following line:
Sheet8.PivotTables("capbylp").PivotFields("Product Family").PivotFields.ClearAllFilters
The error message is:
Object doesn't support this property or method
#SeanCheshire: Thanks for the help. I feel this is much closer to what I want. However, I couldnt get it to work. I played around with it a little bit and am closer. here is what i have...
Sub thisisalsotemp2()
Sheets("Dashboard").Select
Sheet8.PivotTables("capbylp").PivotFields("Product Family") = Range("B33")
End Sub
Error 1004 reads: unable to set the pivotfields property of the pivottable class
in the line: Sheet8.PivotTables("capbylp").PivotFields("Product Family") = Range("B33")

you need to set CurrentPage (and you shouldn't need to clear it first).
Using what is shown in your code, I would have something like:
Sheet8.PivotTables("capbylp").PivotFields("Product Family"). _
PivotFields("MyPivotField").CurrentPage = Range("B33").Value
(broken into 2 lines for readability)

This is slightly related; I wanted to clear multiple-selections whenever the user makes them. Apparently, setting the VisibleItemsList can do that.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xPF As PivotField
Dim nms As Variant
nms = Array("Calculation", _
"Rate Type", _
"xx Hierarchy")
Set xPT = Application.ActiveSheet.PivotTables(1)
For Each xPF In xPT.PageFields
For Each nm In nms
If xPF.Name Like "*" & nm & "*" Then
If UBound(xPF.VisibleItemsList) > 1 Then
xPF.VisibleItemsList = Array("")
End If
End If
Next nm
Next xPF
End Sub

Related

Getting rid of Merged cells With Center across selection

Hello Recently someone posted this in a comment thread in one of my previous questions. The post itself shows a code to remove merged cells and replace them with Central Across Selection
https://codereview.stackexchange.com/questions/197726/getting-rid-of-merged-cells/197730#197730
My issue is that I can't seem to get the code to work. I tried giving the code a go but am having two issues with it. Primarily the:
Sub fixMergedCells(sh As Worksheet)
and later
Set used = sh.UsedRange
Which I don't quite understand and they seem to be stopping me from applying it as a macro button. I otherwise seem to get a debug prompt saying "Method 'UnMerge' of object 'Range' failed" with regards to the line:
.UnMerge
Could you give me a hand in understanding what it is that I can't seem to grasp.
Here is my original code from my other post:
Sub fixMergedCells(sh As Worksheet)
'replace merged cells by Center Acroos Selection
'high perf version using a hack: https://stackoverflow.com/a/9452164/78522
Dim c As Range, used As Range
Dim m As Range, i As Long
Dim constFla: constFla = Array(xlConstants, xlFormulas)
Set used = sh.UsedRange
For i = 0 To 1 '1 run for constants, 1 for formulas
Err.Clear
On Error Resume Next
Set m = Intersect(used.Cells.SpecialCells(constFla(i)), used.Cells.SpecialCells(xlBlanks))
On Error GoTo 0
If Not m Is Nothing Then
For Each c In m.Cells
If c.MergeCells Then
With c.MergeArea
'Debug.Print .Address
.UnMerge
.HorizontalAlignment = xlCenterAcrossSelection
End With
End If
Next c
End If
Next i
End Sub
Sub test_fixMergedCells()
fixMergedCells ActiveSheet
End Sub
Your sub procedure isn't listed in the available 'macros' because it has a non-optional, non-variant parameter.
Try using an optional variant type parameter that can be used or, if omitted, filled with the ActiveSheet (which I assume the button is on).
Sub fixMergedCells(Optional sh As Variant)
If IsMissing(sh) Then Set sh = ActiveSheet
sh.Cells.UnMerge
End Sub
IsMissing can only be used with optional variant type parameters. Sub procedures with optional parameters are only listed as available 'macros' to be assigned to a button if the optional parameter is the variant type.

VBA macro to change filters in pivot table

I'm trying do automate a daily report and therefore I want to create two buttons which change the filters of three pivot tables. In detail the buttons shall change the day which is shown. The first filters on yesterday the second one is a reset button do clear all filters and show all days.
The "Resest"-Button is working but the "Yesterday"-Button not.
At the moment the macro looks like that:
Private Sub CommandButton2_Click()
MsgBox ActiveSheet.Range("B1")
With ActiveSheet.PivotTables("Detail_Digital").PivotFields("Tag").CurrentPage = _
ACtiveSheet.Range("B1").Value
End With
End Sub
I've also tried PivotFilters.Add _ , Type:=xlDateYesterday but that isn't working either.
Any suggestions?
Try the code below, it should work, unless your "Date" is formatted differently between the Pivot's data source and Range("B1").
Note: try to avoid using ActiveSheet, instead use referenced objects. In the case below, replace Worksheets("Sheet1") with your sheet's name.
Code
Option Explicit
Private Sub CommandButton2_Click()
Dim PvtTbl As PivotTable
Dim PvtItm As PivotItem
' set the Pivot Table
Set PvtTbl = Worksheets("Sheet1").PivotTables("Detail_Digital")
With PvtTbl
.PivotFields("Tag").ClearAllFilters ' <-- clear all filters to "Tag"
'Debug.Print Worksheets("Sheet1").Range("B1").Value
For Each PvtItm In .PivotFields("Tag").PivotItems
If PvtItm.Name = Worksheets("Sheet1").Range("B1").Value Then
PvtItm.Visible = True
Else
PvtItm.Visible = False
End If
Next PvtItm
End With
End Sub

running multiple macros when cells in a range are changed

bear with me, as I am a complete vba newbie and wrapping my head around what I already have has already taken me much longer than I care to admit.
I have a workbook with one master list "ITEMS" and several (up to 15) sub-tabs that grab information from the ITEMS sheet. I've been able to make this happen using buttons on each sub sheet which call this code:
Private Sub getNELL_Click()
Sheets("ITEMS").Range("A1:K400").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("ITEMS").Range("O1:O2"), CopyToRange:=Range("A1:K1") _
, Unique:=False
End Sub
This code successfully grabs each relevant row into the sheet each time I click the button, where each getX has a different name/criteria range (getRILEY, getELLE etc.)
But what I'm looking to do next is to have these macros run automatically when any cell in the G column of the ITEMS sheet is changed. In plain text, what I need is:
When [Any Cell in Column G] in Sheet("ITEMS") is changed
Run getNELL, getRiley, getELLE (x15 different macros)
here's my file with all the sheet (sic) in it.
EDIT:
and it's done!
moving the macros to a module instead of in each individual sheet, making them public and removing the _Click, along with the following code worked the magic I needed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("G2:G400")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
getNELL
getMIKA
getRILEY
getJANNA
getWOO
getELLE
getMK
getLAURA
getFLIPSE
getJENN
getCRIS
End If
End Sub
First off, use this link as a resource for triggering an event when cells change. That's usually just in the subroutine declaration.
For the code, change all of your private subs to public subs by replacing "private" with "public". Then in your subroutine list the subroutines to call:
>
Subx
Suby
Subz
end sub
Sorry the answer isn't super detailed as I am typing from my phone. Also, those sub examples should each be on their own line. I can't seem to change that on here.
you have already created filter criteria in ITEM sheet (grey highlighted)
so create one mapping for what sheet needs what criteria range in INDEX sheet
e.g.
SheetName Criteria Mapping
nell O1:O2
mika P1:P2
riley Q1:Q2
janna R1:R2
woo S1:S2
elle O3:O4
mk P3:P4
laura Q3:Q4
flipse R3:R4
jenn S3:S4
cris O5:O6
Add this code in a Module
Public Sub pGet_Data(ByVal SheetName As Worksheet, ByVal CriteriaRng As Range)
ThisWorkbook.Worksheets("ITEMS").Range("A1:K400").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=CriteriaRng, _
CopyToRange:=SheetName.Range("A1:K1"), _
Unique:=False
End Sub
And in Thisworkbook Module add given code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngCriteriaRange As Range
Dim rngOneMap As Range
Dim wksSheet As Worksheet
If Sh.Name = "ITEMS" And Target.Column = 7 Then
Set rngCriteriaRange = Sh.Range("W6:X16") '<--you can make it dynamic
For Each rngOneMap In rngCriteriaRange.Rows
Set wksSheet = ThisWorkbook.Worksheets(rngOneMap.Cells(1, 1).Value)
Application.StatusBar = "Updating [" & wksSheet & "] Sheet"
Call pGet_Data(wksSheet, wksSheet.Range(rngOneMap.Cells(1, 2).Value))
Next rngOneMap
End If
MsgBox "Sheets has been updated.", vbOKOnly, "Be Happy..."
ClearMemory:
Set rngCriteriaRange = Nothing
Set rngOneMap = Nothing
Set wksSheet = Nothing
End Sub
I think this will resolve what you are looking for... :)

Need case-sensitive formatting (Excel)

Sub test(sToken As String)
Cells.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=sToken
Cells.FormatConditions(Cells.FormatConditions.Count).SetFirstPriority
With Cells.FormatConditions(1).Interior
.Pattern = xlPatternLightVertical
.PatternColorIndex = 4
.ColorIndex = 10
End With
Cells.FormatConditions(1).StopIfTrue = False
End Sub
The problem with the code above is, when I use Call test("a") (for example) I get formatted cells with
"a" and "A", but I want just an "a".
Any suggestions?
PS: not skilled in VBA and English, please don't kill =)
Ok, here the full macro for better understanding problem (with my crappy coding skills =P )
Sub FormatTokens()
Call FormatReset 'Clear formatting
Call SetFormatting("d", xlPatternNone, 1, 44)
Call SetFormatting("h", xlPatternCrissCross, 46, 44)
Call SetFormatting("t", xlPatternLightVertical, 4, 10) ' Here the 1st conflict token
Call SetFormatting("p", xlPatternNone, 1, 10)
Call SetFormatting("T", xlPatternNone, 4, 10) ' And here another
Call SetFormatting("v", xlPatternGray16, 49, 24)
' Blah, blah, blah in the same style...
End Sub
Private Sub SetFormatting(sToken As String, oPat As XlPattern, iPatCol As Integer, iCol As Integer)
Cells.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=sToken
Cells.FormatConditions(Cells.FormatConditions.Count).SetFirstPriority
With Cells.FormatConditions(1).Interior
.Pattern = oPat
.PatternColorIndex = iPatCol
.ColorIndex = iCol
End With
Cells.FormatConditions(1).StopIfTrue = False
End Sub
Macro do the job, but not with "t" and "T" tokens
Explicitly specify Upper Case, Lower Case formatting.
Add the condition to check,
if UCase(range.value) = UCase(sToken) then
// do formatting
end if
EDIT
This works:
Cells.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=EXACT($B1,""a"")"
But this doesn't:
sToken = "=EXACT($A1, """"" & sToken & """"")"
Cells.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:=sToken
Use:
Formula1:= "=EXACT(A1;""" & sToken & """)"
Or:
Formula1:="=EXACT(" & Cells(1, 1).Address(False, False, xlA1) & ";""" & sToken & """)"
If you want to apply to a subrange you can simply change that part.
Well, after some deep readings of couple forums I found what I needed.
Here the solution, suitable in many different situations: set custom event handlers =)
Steps for set Worksheet events from VBA:
1. Create class module, which will be Your event handler (named clsWorksheetEventHandler in my case)
2. Code him:
Option Explicit
Public WithEvents WorksheetEvents As Worksheet 'As an object whose events should be handled
Private Sub WorksheetEvents_Change(ByVal Target As Range) 'Event to handle
'Some code You need to handle this event
End Sub
3. In Your working module add subroutines to initialize and terminate handling:
Option Explicit
Dim oWorksheetEventHandler As clsWorksheetEventHandler 'Ref for Your class
Dim colWorksheetEventHandlers As Collection 'For all referrals
Sub WorksheetEventHandlers_initialize()
'Create new Collection to store ours handlers
Set colWorksheetEventHandlers = New Collection
'Loop through worksheets
For Each Worksheet In Worksheets
'Create new instance of the event handler class
Set WorksheetEventHandler = New clsWorksheetEventHandler
'Set it to handle events in worksheet
Set WorksheetEventHandler.WorksheetEvents = Worksheet
'And add it to our collection
colWorksheetEventHandlers.Add WorksheetEventHandler
Next Worksheet
End Sub
Sub WorksheetEwentHandlers_terminate()
'Loop through our collection
For Each WorksheetEventHandler In colWorksheetEventHandlers
'Clear event handler
Set WorksheetEventHandler = Nothing
Next WorksheetEventHandler
'And finally clear memory
Set colWorksheetEventHandlers = Nothing
End Sub
4. ?????????????????????
5. PROFIT!!!!!!
I hope You enjoy =)
PS: Here are some links that have helped me greatly
How to create application-level event handlers in Excel
Controlling multiple textboxes on a userform

Excel vba: error hiding calculated field in Pivot table

I have written several Subs to show/hide fields in a PivotTable.
Now I am trying to do the same with a calculated field, but I get an error when hiding it.
I took my code from the recorder and the recorder's code also halts on the last line.
I googled the error message, without serious result.
Sub PrRemove()
'remove PR
Dim pt As PivotTable
Set pt = ActiveSheet.PivotTables("MyPivot")
pt.PivotFields("MyField").Orientation = xlHidden '<- here is the error
End Sub
The same code works fine if MyField is a normal field (not a calculated one).
I am using Excel 2007 with SP2.
Any clue ?
EDIT on 17 June 2010: I also tried using pt.DataFields instead of pt.PivotFields, with exactly the same behaviour. The error message says "Unable to set the orientation of the PivotField class".
after much hair pulling i have found a workaround.
if you add more than one pivot field (calculated or otherwise) excel creates a grouped field called Values. you can set the orientation property of PivotField("Values") to xlHidden and it bullets both fields. So if you want to remove a calculated field, just add a non-calculated field, set PivotField("Values").orientation to xlHidden and you're done.
nobody said it would be pretty...
With ActiveSheet.PivotTables("PivottableName").PivotFields("Values")
.PivotItems("CalcFieldName").Visible = False
End With
I wanted to easily remove data fields (calculated fields or not), like it would be done manually.
And I finally found this solution (Excel 2010) :
Set pt = ActiveSheet.PivotTables("mypivottable")
For Each pi In pt.DataPivotField.PivotItems
pi.Visible = False
Next
Well, I will give you the confirmation you need. It seems using the Orientation property on a "Calulated Field" just does not work, and I would have to agree this is a bug and not a common "usage" error. I was able to duplicate "hiding/showing" the field without having to remove ("Delete") the calculated field. This allows the user to physically drag the calculated field from the field list after you have progammatically "hidden" the field. This is not a bad solution because it duplicates the user-interface. (Using Excel 2003.)
'2009.09.25 AMJ
'work around for
' 1004, Unable to set the Orientation property of the PivotField class
'when setting orientation property to hidden of calculated field, as in
' ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Field1").Orientation = xlHidden
Public Sub Hide()
'hide the data without removing the calculated field
' this allows the user to physically drag the
' calculated field from the field list once we
' have "hidden" it programmatically.
' if we use the "delete" method, the field is removed
' from the pivot table and the field list
Dim oWS As Worksheet
Dim oPT As PivotTable
Dim oPF As PivotField
Dim oPI As PivotItem
Set oWS = ActiveSheet
Set oPT = oWS.PivotTables(1)
For Each oPF In oPT.DataFields
If oPF.SourceName = "Field1" Then
'Stop
Exit For
End If
Next
Set oPI = oPF.DataRange.Cells(1, 1).PivotItem
'oPI.DataRange.Select
oPI.Visible = False
End Sub
Public Sub Show()
'show just reads the pivot field to the data fields
Dim oWS As Worksheet
Dim oPT As PivotTable
Dim oPF As PivotField
Set oWS = ActiveSheet
Set oPT = oWS.PivotTables(1)
For Each oPF In oPT.PivotFields
If oPF.SourceName = "Field1" Then
'Stop
Exit For
End If
Next
oPT.AddDataField oPF
End Sub
[original answer]
Most likely you cannot hide this item because it is the last visible item. Instead, try removing it.
Here is a little workaround I discovered today, again not very elegant but at least it doesn't need much code, it will hide ALL the fields and you will need to reshow the ones you want after:
objTable.DataPivotField.Orientation = xlHidden
You may run into an error if excel for some reason thinks the datapivotfield is empty, but to fix this just add in another field as a datafield right before the above statement. Also make sure its the letter l not the number 1 in xlHidden vba's default font has them looking very very similar.
Happy Coding
It seems that to hide a calculated field you need to first hide a pivot field called "Values".
PivotTable(1).PivotFields("Values").Orientation = xlHidden
For Each PF In PT.DataFields
PF.Orientation = xlHidden
Next PF
I'm assuming that field only seem to exist if you've got two or more fields in your xlDataField position.
Thanks Alinboss for pointing me in the right direction. I was sure I tried your method before and failed - turns out the order is important!
P.s. Your code still does not work with only one calculated data field
Laurent Bosc's code checks out so I voted it up. My full code includes adding data after hiding it all. The code is placed on Sheet1(Sheet1).
Private Sub Refresh_Pivot()
Dim NewMetric As String
Dim pt As PivotTable, objDataField As Object
NewMetric = "your_custom_metric"
'-------update pivot table 1, hide all elements including calculated field----
Application.EnableEvents = False
Set pt = Sheet1.PivotTables("PivotTable1")
For Each Pi In pt.DataPivotField.PivotItems
Pi.Visible = False
Next
'--------add a new data field to the pivot table----------------------------
With pt
.AddDataField.PivotFields(NewMetric), "Sum of " & NewMetric, xlSum
End With
Application.EnableEvents = True
End Sub
I don't think this is an excel bug, I think it's a 'feature'. ;-)
Re: #AMissico, there is no problem in excel hiding all of the fields in a pivot table, but he may be talking about items - you can't hide the last item in a pivot field.
This is the code I routinely use to do what you are trying to do. These macros were developed on Excel 2002 & 2003. I don't hide CalculatedFields, I delete them.
' Hide all fields.
' #param ThePivotTable to operate upon.
Sub HidePivotFields(ByVal ThePivotTable As PivotTable)
Dim pField As PivotField
For Each pField In ThePivotTable.CalculatedFields
pField.Delete
Next pField
For Each pField In ThePivotTable.PivotFields
pField.Orientation = xlHidden
Next pField
Set pField = Nothing
End Sub
' Removes FieldName data from ThePivotTable
Sub HideField(ByVal ThePivotTable As PivotTable, _
ByVal FieldName As String)
If FieldExists(ThePivotTable, FieldName) = True And _
CalculatedFieldExists(ThePivotTable, FieldName) = False Then
ThePivotTable.PivotFields(FieldName).Orientation = xlHidden
End If
End Sub
' Returns True if FieldName exists in ThePivotTable
'
' #param ThePivotTable to operate upon.
' #param FieldName the name of the specific pivot field.
Function FieldExists(ByVal ThePivotTable As PivotTable, _
ByVal FieldName As String) As Boolean
Dim pField As PivotField
For Each pField In ThePivotTable.PivotFields
If pField.SourceName = FieldName Then
FieldExists = True
Exit For
End If
Next pField
Set pField = Nothing
End Function
' Checks if the field FieldName is currently a member of the
' CalculatedFields Collection in ThePivotTable.
' #return True if a CalculatedField has a SourceName matching the FieldName
' #return False otherwise
Function CalculatedFieldExists(ByVal ThePivotTable As PivotTable, _
ByVal FieldName As String) As Boolean
Dim pField As PivotField
CalculatedFieldExists = False
For Each pField In ThePivotTable.CalculatedFields
If pField.SourceName = FieldName Then
CalculatedFieldExists = True
End If
Next pField
Set pField = Nothing
End Function
' Returns a Pivot Field reference by searching through the source names.
'
' This function is a guard against the user having changed a field name on me.
' #param ThePivotTable to operate upon.
' #param FieldName the name of the specific pivot field.
Function GetField(ByVal ThePivotTable As PivotTable, _
ByVal FieldName As String) As PivotField
Dim pField As PivotField
For Each pField In ThePivotTable.PivotFields
If pField.Name <> "Data" Then
If pField.SourceName = FieldName Then
Set GetField = pField
Exit For
End If
End If
Next pField
Set pField = Nothing
End Function
' Counts the number of currently visible pivot items in a field.
' #param ThePivotItems the collection of pivot itemns in a field.
' #return the count of the visible items.
Function PivotItemCount(ByVal ThePivotItems As PivotItems) As Long
Dim pItem As PivotItem
Dim c As Long
For Each pItem In ThePivotItems
If pItem.Visible = True Then c = c + 1
Next pItem
PivotItemCount = c
Set pItem = Nothing
End Function
' Hides a single pivot item in a pivot field, unless it's the last one.
' #param FieldName pivot field containing the pivot item.
' #param ItemName pivot item to hide.
Sub HidePivotItem(ByVal ThePivotTable As PivotTable, _
ByVal FieldName As String, _
ByVal ItemName As String)
Dim pField As PivotField
Set pField = GetField(ThePivotTable, FieldName)
If Not pField Is Nothing Then
If PivotItemCount(pField.PivotItems) > 1 Then
pField.PivotItems(ItemName).Visible = False
End If
End If
Set pField = Nothing
End Sub
I am having the exact same problem as you.
It looks like I'm going to have to delete the calculated field and readd it rather than hiding/showing it.
I accidentally discovered a workaround to this the first time I attempted to hide a calculated field, so thought I would share it here:
Instead of modifying the orientation property, you can instead instruct the code to select the cell in the pivot table that contains the title of the calculated field you want to hide, and then delete the selection. This works as long as you have another datafield already in the table. Example below:
Scenario: Pivot table covers the range A1:G10. Calculated field "Margin" is already in the table, and you want to add the data field "Sales" and remove the "Margin" calc field.
Code to execute:
'Add Sales data field
ActiveSheet.PivotTables(Pname).AddDataField ActiveSheet.PivotTables( _
Pname).PivotFields("SALES"), "Sum of SALES", xlSum
'At this point, the datafield titles are in vertically adjacent rows, named "Sum
'of Margin" and "Sum of Sales" at locations B3 and B4 respectively.
'Remove the "Sum of Margin" calculated field
Range("B3").Delete
Not sure why this works, but I'm glad we at least have this to work with!
Fortunately there is a very easy way to hide a datafield. You were all wrong mistakeing pivotfields with datafields. I'm presenting a piece of code that empties a pivot table no matter how many pivot fields/data fields were initially in the pivot :
Sub Macro1()
Dim p As PivotTable
Dim f As PivotField
Set p = ActiveSheet.PivotTables(1)
For Each f In p.PivotFields
If f.Orientation <> xlHidden Then
f.Orientation = xlHidden
End If
Next f
For Each f In p.DataFields
If f.Orientation <> xlHidden Then
f.Orientation = xlHidden
End If
Next f
End Sub
Have you changed the name of the calculated field? Was it originally 'Sum of MyField'? Try looking at the SourceName property and if it's different using that.
Have you tried pt.CalculatedFields("MyField").Orientation = xlHidden ?
I know it is kind of late, but i see that this problem has not been answered confidently yet and i was facing the same problem having hard time to find useful info. So, i hope this post may help somebody...
If you have your data stored in data model, then instead of PivotFields, use CubeFields .
I had the same problem and i experimented with a simple workbook which did not had a data model and my code worked perfectly (using PivotFields).
It only returned error in the workbook with the data model.
So, i made this change and boom! it worked!
My suggestion is to use the following code:
Sub PrRemove()
'remove PR
Dim pt As PivotTable
Set pt = ActiveSheet.PivotTables("MyPivot")
pt.CubeFields("MyField").Orientation = xlHidden '<- here is the error
End Sub
Thanks to #user4709164 answer i got this code, its working perfectly for me:
my pivot columns all ends with X or Y to indicate axis so i use the last char for field caption.
Public Sub PivotFieldsChange()
Dim ValType As String, param As String
Dim pf As PivotField
Dim pt As PivotTable
Application.ScreenUpdating = False
Sheet = "mysheet"
'select between % calculated column or normal column
If Range("Z1").Value = 1 Then
ValType = "%"
Else: ValType = ""
End If
Application.EnableEvents = False
For Each pt In Sheets(Sheet).PivotTables
Select Case pt.Name
Case "case1": param = "param1"
Case "case2": param = "param2"
Case "case3": param = "param3"
Case Else: GoTo line1
End Select
pt.PivotFields("Values").PivotItems("X").Visible = False
pt.PivotFields("Values").PivotItems("Y").Visible = False
pt.PivotFields (param & ValType & "_X")
pt.PivotFields(param & ValType & "_X").Orientation = xlDataField
pt.PivotFields (param & ValType & "_Y")
pt.PivotFields(param & ValType & "_Y").Orientation = xlDataField
For Each pf In pt.DataFields
pf.Function = xlAverage
pf.Caption = Right(pf.Caption, 1)
Next
line1:
Next pt
Application.EnableEvents = True
End Sub