I'm using Excel VBA to hide/show elements on slicer depending upon user selection.
I have the following code :
Private Sub removeFilterWithSlicer()
Dim slicerCache As slicerCache
Set slicerCache = ThisWorkbook.SlicerCaches("Slicer_Channel1")
slicerCache.SlicerItems("A").Selected = False
slicerCache.SlicerItems("B").Selected = False
slicerCache.SlicerItems("C").Selected = False
slicerCache.SlicerItems("D").Selected = False
slicerCache.SlicerItems("E").Selected = False
slicerCache.SlicerItems("F").Selected = False
End Sub
where A, B etc. are names of elements in slicer. I've cross checked the name of slicer cache ("Slicer_Channel1"). The issue is that the elements don't get deselected as they are supposed to. When I'm debugging the code, I found that each element gets deselected one by one but as soon as I reach the end of procedure i.e. End Sub, they all get back to being in selected state.
Any pointers ?
This code shows how to filter a Slicer on an array called vSelection.
Option Explicit
Sub FilterSlicer()
Dim slr As Slicer
Dim sc As SlicerCache
Dim si As SlicerItem
Dim i As Long
Dim vItem As Variant
Dim vSelection As Variant
Set sc = ActiveWorkbook.SlicerCaches("Slicer_ID")
'Set sc = slr.SlicerCache
vSelection = Array("B", "C", "E")
For Each pt In sc.PivotTables
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
Next pt
With sc
'At least one item must remain visible in the Slicer at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.SlicerItems(1).Selected = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .SlicerItems.Count
If .SlicerItems(i).Selected Then .SlicerItems(i).Selected = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vSelection
.SlicerItems(vItem).Selected = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vSelection, "|")), UCase(.SlicerItems(1).Name)) = 0 Then .SlicerItems(1).Selected = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Slicer, so I have cleared the filter"
End If
On Error GoTo 0
End With
For Each pt In sc.PivotTables
pt.ManualUpdate = False
Next pt
End Sub
at least one has to be selected. works the same way when selecting with a mouse. you cannot un-select all
Related
This is my function, the code stops on the line "If pitem.visible=True" on the first iteration (line 17). While the code is running, I always have visible items int the field.
The code is not even setting any property to visible and it's working very well if I filter anything other than a date.
Function tableau()
Dim fld As PivotField
Dim pitem As PivotItem
Dim i As Long
Dim arr() As Variant
Dim a As String
Dim pvt As String
pvt = "PivotTable"
Sheets("Données").ListObjects("table1").AutoFilter.ShowAllData
Sheets("PivotTableSheet").Activate
Sheets("PivotTableSheet").PivotTables(pvt).ManualUpdate = True
Sheets("PivotTableSheet").PivotTables(pvt).PivotFields("Date").EnableMultiplePageItems = True
For Each fld In Sheets("PivotTableSheet").PivotTables(pvt).PivotFields
If fld.Orientation <> xlHidden And (fld.Orientation = xlPageField) Then 'loop through filtered pivot fields
i = 1
For Each pitem In fld.PivotItems 'loop through visible items in filtered pivot fields
If pitem.Visible = True Then
ReDim Preserve arr(1 To i) As Variant
arr(i) = pitem
i = i + 1
End If
Next pitem
Sheets("Données").ListObjects("table1").Range.AutoFilter Field:=TRVFILTRE(fld.Name), Criteria1:=arr, Operator:=xlFilterValues
End If
Next fld
Sheets("PivotTableSheet").PivotTables(pvt).ManualUpdate = False
End Function
When iterating over PivotItems, there's a couple of bottlenecks and gotchas that you want to avoid. See my post at http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/ for more on this.
Among other things, you want to set the PivotTable's ManualUpdate property to TRUE while you do the iteration and then back to FALSE when you're done. Otherwise Excel will try to update the PivotTable each time you change the visibility of a PivotItem. And you also want to ensure that at least one item remains visible at all times. I use something like this:
Option Explicit
Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vItems As Variant
Set pt = ActiveSheet.PivotTables("PivotTable1") '<= Change to match your PivotTable
Set pf = pt.PivotFields("CountryName") '<= Change to match your PivotField
vItems = Array("FRANCE", "BELGIUM", "LUXEMBOURG") '<= Change to match the list of items you want to remain visible
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
With pf
'At least one item must remain visible in the PivotTable at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.PivotItems(1).Visible = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .PivotItems.Count
If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vItems
.PivotItems(vItem).Visible = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vItems, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
End If
On Error GoTo 0
End With
pt.ManualUpdate = False
End Sub
You don't have to iterate through PivotItems if all you want to do is make each PivotItem visible. Instead, just use the .ClearAllFilters method.
Something like:
With Sheets("PivotTableSheet").PivotTable("PivotTable").PivotFields("Date")
.ClearAllFilters
.CurrentPage = "(All)"
End With
Trying to narrow down this VBA script w/o having to list out . I'm a basic Macro user. How can I get one selected = True and the rest = False without having to list all 160?
With ActiveWorkbook.SlicerCaches("Slicer_Organization")
.SlicerItems("900110 - Danish Bemidji ").Selected = True
.SlicerItems("900101 - Arabic Bemidji").Selected = False
.SlicerItems("900105 - Chinese Callaway 1st Half").Selected = False
.SlicerItems("900106 - Chinese Callaway 2nd Half").Selected = False
.SlicerItems("900115 - Finnish Bemidji ").Selected = False
.SlicerItems("900120 - French Bemidji 1st Half ").Selected = False
.SlicerItems("900121 - French Bemidji 2nd Half ").Selected = False
Filtering SlicerItems can be tricky, because at least one item must remain visible at all times.
This code shows how to filter a Slicer on an array called vSelection. To amend to your needs, just change the vSelection = Array("B", "C", "E") line so that it contains the item(s) of interest.
Option Explicit
Sub FilterSlicer()
Dim slr As Slicer
Dim sc As SlicerCache
Dim si As SlicerItem
Dim i As Long
Dim vItem As Variant
Dim vSelection As Variant
Set sc = ActiveWorkbook.SlicerCaches("Slicer_ID")
vSelection = Array("B", "C", "E")
For Each pt In sc.PivotTables
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
Next pt
With sc
'At least one item must remain visible in the Slicer at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.SlicerItems(1).Selected = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .SlicerItems.Count
If .SlicerItems(i).Selected Then .SlicerItems(i).Selected = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vSelection
.SlicerItems(vItem).Selected = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vSelection, "|")), UCase(.SlicerItems(1).Name)) = 0 Then .SlicerItems(1).Selected = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Slicer, so I have cleared the filter"
End If
On Error GoTo 0
End With
For Each pt In sc.PivotTables
pt.ManualUpdate = False
Next pt
End Sub
You can loop through all SlicerItems in your SlicerCache using a For Each loop:
Dim si as SlicerItem
For Each si In ActiveWorkbook.SlicerCaches("Slicer_Organization").SlicerItems
si.Selected = (si.Name = "900110 - Danish Bemidji")
Next si
That (si.Name = "900110 - Danish Bemidji") will return a True or False and set the Selected property of the SlicerItem you are iterating appropriately.
Sub ExcelGuruVG()
Dim myval As String
myval = "VG"
Dim sli as SlicerItem
with Activeworkbook.slicercaches("Slicer_SLICERNAME")
for Each sli in SlicerItems
if sli.Name = myval then
sli.select = true
Else
sli.selected = False
End if
Next sli
End with
End Sub
I tried the code that was shared by Venugopal and combined it with JNevill's code, and it worked!
Thanks a bunch to both of you!
The adjustment I made is as below:
Sub ExcelGuruVG()
Dim myval As String
myval = ThisWorkbook.Worksheets("Sheet1").Range("A2").Value 'Taking the value from Sheet1 in Cell A2
Dim sli As SlicerItem
With ActiveWorkbook.SlicerCaches("Slicer_SlicerName1")
For Each sli In ActiveWorkbook.SlicerCaches("Slicer_SlicerName1").SlicerItems
If sli.Name = myval Then
sli.Selected = True
Else
sli.Selected = False
End If
Next sli
End With
End Sub
The following is the code i am using to update the value of my slicer.
Sub country_select()
Application.ScreenUpdating = False
country_selected = ActiveSheet.Shapes(Application.Caller).Name
ActiveWorkbook.SlicerCaches("Slicer_Country").ClearManualFilter
For Count = 1 To 13 'countries
country = Sheet5.Range("E2").Offset(Count, 0).Value
If country = country_selected Then
ActiveWorkbook.SlicerCaches("Slicer_Country").SlicerItems(country).Selected = True
Else
ActiveWorkbook.SlicerCaches("Slicer_Country").SlicerItems(country).Selected =
False
End If
Next Count
Application.ScreenUpdating = True
End Sub
The country variable is not updating its value(only taking empty value).
I don't understand the reason for this.
I am trying to link a map to a macro hence the input.
I'm not sure why you need to interate through the range E3:E14. If all you want to do is to set the Slicer to show the item corresponding to the shape the user has selected, I would just use something like this:
Option Explicit
Sub country_select()
Dim si As SlicerItem
Dim Country As String
Dim sc As SlicerCache
Application.ScreenUpdating = False
Country = ActiveSheet.Shapes(Application.Caller).Name
Set sc = ActiveWorkbook.SlicerCaches("Slicer_Country")
With sc
.ClearAllFilters
For Each si In sc.SlicerItems
If si.Name <> Country Then si.Selected = False
Next si
End With
Application.ScreenUpdating = True
End Sub
Note that if the slicer was for a PivotTable (and not for a Table) I would set the .ManualUpdate propery of the PivotTable to TRUE before the loop, and to FALSE after, so that the PivotTable didn't try to update after each and every SlicerItem is selected.
And if this was for a PivotTable (and not for a Table) there is no need to iterate over a Slicer at all (which is inefficient/slow). Instead, just put the Country field in the Pivot as a PageField, and just set the .CurrentPage of the PageField directly, like so:
Sub FilterPivot()
Dim pf As PivotField
Set pf = ActiveSheet.PivotTables("PivotTable1").PivotFields("Country")
pf.CurrentPage = Application.Caller
End Sub
I've been trying to build a code to filter all items within a Pivot Table which contain a specific text fragment. I initially imagined I could use asterisks (*) to indicate any string before or after my text, but VBA reads that as a character instead. This is necessary to display the Pivot Table array in a Userform Listbox. Look what I tried:
Sub FilterCstomers()
Dim f As String: f = InputBox("Type the text you want to filter:")
With Sheets("Customers Pivot").PivotTables("Customers_PivotTable")
.ClearAllFilters
.PivotFields("Concatenation for filtering").CurrentPage = "*f*"
End With
End Sub
Try the code below to filter all items in field "Concatenation for filtering" that are Like wild card * and String f received from InputBox.
Option Explicit
Sub FilterCstomers()
Dim PvtTbl As PivotTable
Dim PvtItm As PivotItem
Dim f As String
f = InputBox("Type the text you want to filter:")
' set the pivot table
Set PvtTbl = Sheets("Customers Pivot").PivotTables("Customers_PivotTable")
With PvtTbl.PivotFields("Concatenation for filtering")
.ClearAllFilters
For Each PvtItm In .PivotItems
If PvtItm.Name Like "*" & f & "*" Then
PvtItm.Visible = True
Else
PvtItm.Visible = False
End If
Next PvtItm
End With
End Sub
Why not just:
.PivotFields("PivotFieldName").PivotFilters.Add2 Type:=xlCaptionContains, Value1:="X"
You can tweak Shai's answer to significantly speed things up, by:
removing the TRUE branch of the IF as it is not needed
setting ManualUpdate to TRUE while the code executes, to stop the
PivotTable from recalculating each time you change the visible
status of any PivotItems.
Turning off screen updating and calculation (in case there are
volatile functions in the workbook) until you are done
You probably also want to put an Option CompareText in there if you want your comparisons to be case insensitive.
And you probably want some error handling in case the user types something that doesn't exist in the PivotTable.
You might want to give my blogpost on this stuff a read, because PivotTables are very slow to filter, and it discusses many ways to speed things up
Here's a reworked example of Shai's code:
Option Explicit
Option Compare Text
Sub FilterCstomers()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim f As String
f = InputBox("Type the text you want to filter:")
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set pt = Sheets("Customers Pivot").PivotTables("Customers_PivotTable")
Set pf = pt.PivotFields("Concatenation for filtering")
pt.ManualUpdate = True
With pf
.ClearAllFilters
On Error GoTo ErrHandler
For Each pi In .PivotItems
If Not pi.Name Like "*" & f & "*" Then
pi.Visible = False
End If
Next pi
End With
ErrHandler:
If Err.Number <> 0 Then pf.ClearAllFilters
pt.ManualUpdate = False
On Error GoTo 0
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
I have a pivot table, and I am trying to select certain pivot items based on values in an array. I need this process to go faster, so I have tried using Application.Calculation = xlCalculationManual and PivotTables.ManualUpdate = True, but neither seem to be working; the pivot table still recalculates each time I change a pivot item.
Is there something I can do differently to prevent Excel from recalculating each time?
Or is there a way to deselect all items at once (not individually) to make the process go quicker?
Here is my code:
Application.Calculation = xlCalculationManual
'code to fill array with list of companies goes here
Dim PT As Excel.PivotTable
Set PT = Sheets("LE Pivot Table").PivotTables("PivotTable1")
Sheets("LE Pivot Table").PivotTables("PivotTable1").ManualUpdate = True
Dim pivItem As PivotItem
'compare pivot items to array.
'If pivot item matches an element of the array, make it visible=true,
'otherwise, make it visible=false
For Each pivItem In PT.PivotFields("company").PivotItems
pivItem.Visible = False 'initially make item unchecked
For Each company In ArrayOfCompanies()
If pivItem.Value = company Then
pivItem.Visible = True
End If
Next company
Next pivItem
It seems that you really want to try something different to significantly reduce the time it takes to select the required items in pivotttable.
I propose to use a “MirrorField”, i.e. a copy of the “Company” to be used to set in the sourcedata of the pivottable the items you need to hide\show.
First you need to add manually (or programmatically) the “MirrorField” and named same as the source field with a special character at the beginning like “!Company” the item must be part of the sourcedata and it can be placed in any column of it (as this will a “programmer” field I would place it in the last column and probably hidden as to not creating any issues for\with the users)
Please find below the code to update the pivottable datasource and to refresh the pivottable
I’m also requesting the PivotField to be updated just make it flexible as it then can be used for any field (provided that the “FieldMirror” is already created)
Last: In case you are running any events in the pivottable worksheet they should be disable and enable only to run with the last pivottable update
Hope this is what you are looking for.
Sub Ptb_ShowPivotItems_MirrorField(vPtbFld As Variant, aPtbItmSelection As Variant)
Dim oPtb As PivotTable
Dim rPtbSrc As Range
Dim iCol(2) As Integer
Dim sRC(2) As String
Dim sFmlR1C1 As String
Dim sPtbSrcDta As String
Rem Set PivotTable & SourceData
Set oPtb = ActiveSheet.PivotTables(1)
sPtbSrcDta = Chr(34) & oPtb.SourceData & Chr(34)
Set rPtbSrc = Evaluate("=INDIRECT(" & sPtbSrcDta & ",0)")
Rem Get FieldMirrow Position in Pivottable SourceData (FieldMirrow Already present SourceData)
With rPtbSrc
iCol(1) = -1 + .Column + Application.Match(vPtbFld, .Rows(1), 0)
iCol(2) = Application.Match("!" & vPtbFld, .Rows(1), 0)
End With
Rem Set FieldMirror Items PivotTable SourceData as per User Selection
sRC(1) = """|""&RC" & iCol(1) & "&""|"""
sRC(2) = """|" & Join(aPtbItmSelection, "|") & "|"""
sFmlR1C1 = "=IF(ISERROR(SEARCH(" & sRC(1) & "," & sRC(2) & ")),""N/A"",""Show"")"
With rPtbSrc.Offset(1).Resize(-1 + rPtbSrc.Rows.Count).Columns(iCol(2))
.Value = "N/A"
.FormulaR1C1 = sFmlR1C1
.Value = .Value2
End With
Rem Refresh PivotTable & Select FieldMirror Items
With oPtb
Rem Optional: Disable Events - In case you are running any events in the pivottable worksheet
Application.EnableEvents = False
.ClearAllFilters
.PivotCache.Refresh
With .PivotFields("!" & vPtbFld)
.Orientation = xlPageField
.EnableMultiplePageItems = False
Rem Optional: Enable Events - To triggrer the pivottable worksheet events only with last update
Application.EnableEvents = True
.CurrentPage = "Show"
End With: End With
End Sub
It seems unavoidable to have the pivotable refreshed every time a pivotitem is updated.
However I tried approaching the problem from the opposite angle. i.e.:
1.Validating the “PivotItems to be hidden” before updating the pivottable.
2.Also making make all items visible at once instead of “initially make item unchecked” one by one.
3.Then hiding all the items not selected by the user (PivotItems to be hidden)
I ran a test with 6 companies selected out of a total of 11 and the pivottable was updated 7 times
Ran also your original code with the same situation and the pivottable was updated 16 times
Find below the code
Sub Ptb_ShowPivotItems(aPtbItmSelection As Variant)
Dim oPtb As PivotTable
Dim oPtbItm As PivotItem
Dim aPtbItms() As PivotItem
Dim vPtbItm As Variant
Dim bPtbItm As Boolean
Dim bCnt As Byte
Set oPtb = ActiveSheet.PivotTables(1)
bCnt = 0
With oPtb.PivotFields("Company")
ReDim Preserve aPtbItms(.PivotItems.Count)
For Each oPtbItm In .PivotItems
bPtbItm = False
For Each vPtbItm In aPtbItmSelection
If oPtbItm.Name = vPtbItm Then
bPtbItm = True
Exit For
End If: Next
If Not (bPtbItm) Then
bCnt = 1 + bCnt
Set aPtbItms(bCnt) = oPtbItm
End If
Next
ReDim Preserve aPtbItms(bCnt)
.ClearAllFilters
For Each vPtbItm In aPtbItms
vPtbItm.Visible = False
Next
End With
End Sub