hope everyone is well.
Ive got this code that makes a slicer selection (first item):
Sub test()
Dim sc As SlicerCache
Set sc = ActiveWorkbook.SlicerCaches("Slicer_book1")
On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each pt In sc.PivotTables
pt.ManualUpdate = True
Next pt
With ActiveWorkbook.SlicerCaches("Slicer_book1")
.ClearManualFilter
cnt = .SlicerItems.Count
If cnt > 1 Then
For i = 2 To cnt
.SlicerItems(i).Selected = False
Next
End If
End With
For Each pt In sc.PivotTables
pt.ManualUpdate = False
Next pt
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox ("Error in updating slicer filters.")
Resume exitHandler
somehow, this code works, but it is incedibly show. So, I was wondering whether anyone has any advice re how to properly speed this up?
Thanks and regards.
I prefer to use the pivot table name than slicer.
Sub test()
Dim sc As SlicerCache
Dim SIName As String
Dim pt As PivotTable, PTF As PivotField
Set sc = ActiveWorkbook.SlicerCaches("Slicer_book1")
On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each pt In sc.PivotTables
pt.ManualUpdate = True
Next pt
With ActiveWorkbook.SlicerCaches("Slicer_book1")
'.ClearManualFilter
cnt = .SlicerItems.Count
If cnt > 1 Then
SIName = .SlicerItems(1).Name
End If
End With
'Pivot is the sheet name where the pivot table is located
ActiveWorkbook.Worksheets("Pivot").Activate
Set pt = ActiveWorkbook.Worksheets("Pivot").PivotTables("NameOfPivotTable")
'Book is pivot field
Set PTF = pt.PivotFields("Book")
PTF.ClearAllFilters
PTF.CurrentPage = SIName
For Each pt In sc.PivotTables
pt.ManualUpdate = False
Next pt
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox ("Error in updating slicer filters.")
Resume exitHandler
End Sub
Hope this help
Related
This is a re-post of my problem here because I dun goofed and thought I solved it when my VBA didn't work.
Essentially what I want the VBA to do is go to the pivot tables across multiple sheets, in the quantity field I want it to select all and then deselect 0 and blank. This will select new data in the filter when I have refreshed it with the new input data for the report I do on a weekly basis. The code is as below
Sub Main()
With ThisWorkbook
FilterOutZeroAndBlanks .Worksheets("Cairns Table").PivotTables("PivotTable1")
FilterOutZeroAndBlanks .Worksheets("Other Table").PivotTables("PivotTable1")
End With
End Sub
Public Sub FilterOutZeroAndBlanks(pvt As PivotTable)
Dim pvtField As PivotField
Set pvtField = pvt.PivotFields("Quantity")
Dim item As PivotItem
Dim counter As Long
Dim targetCounter As Long
With pvtField
For Each item In .PivotItems
If item.Visible Then counter = counter + 1
Next item
If .PivotItems("0").Visible And .PivotItems("(blank)").Visible Then
targetCounter = 2
ElseIf .PivotItems("0").Visible Or .PivotItems("(blank)").Visible Then
targetCounter = 1
End If
If Not targetCounter = counter Then
.PivotItems("0").Visible = False
.PivotItems("(blank)").Visible = False
End If
End With
End Sub
Blockquote
Try this:
Public Sub FilterOutZeroAndBlanks(pvt As PivotTable)
With pvt.PivotFields("Quantity")
.ShowAllItems = True 'unhide all
.PivotItems("0").Visible = False
.PivotItems("(blank)").Visible = False
End With
End Sub
Community, need your help here, other than the fact the macro initially did nothing, I have now an error 1004: Application or object defined error!!
I updated my query to simplify and hoping to correct the no effect result from the macro, but now I made it worst.. any help please
Sub changeFilters()
Dim wsChart As Worksheet: Set wsChart = Sheets("Graph Data")
Dim wsPivot As Worksheet: Set wsPivot = Sheets("PCW_pivot")
Dim pt As PivotTable: Set pt = wsPivot.PivotTables("PCW1")
Dim pf As PivotField: Set pf = pt.PivotFields("[Range].[Geography].[Geography]")
Dim SelGeo As Variant: SelGeo = Sheets("Graph Data").Range("E3").Value
'turn on automatic update / calculation in the Pivot Table
With SelGeo <> "WW"
pt.ManualUpdate = True
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
pf.PivotFilters.Add Type:=xlCaptionEquals, Value1:="[SelGeo]"
pt.RefreshTable
End With
With SelGeo = "WW"
.ClearAllFilters
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I have a macro that work but it takes too long to complete - 45sec.
What it does is to take a combo box result to update a pivot table filtering.
Do you know what I did wrong and how could I improve it please?:)
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim wsChart As Worksheet
Dim wsPivot As Worksheet
Dim SelGeo As Variant
'turn on automatic update / calculation in the Pivot Table
Set wsChart = ThisWorkbook.Sheets("Graph Data")
Set wsPivot = ThisWorkbook.Sheets("PCW_pivot")
Set pt = ThisWorkbook.Sheets("PCW_pivot").PivotTables("Pivot_table1")
Set SelGeo = ThisWorkbook.Sheets("Graph Data").Range("SelGeo")
pt.ManualUpdate = True
Application.ScreenUpdating = False
ThisWorkbook.Sheets("PCW_pivot").PivotTables("Pivot_table1").ClearAllFilters
If ThisWorkbook.Sheets("Graph Data").Range("SelGeo") = WW Then
Exit Sub
End If
For Each pi In pt.PivotFields("Geo").PivotItems
Select Case pi.Name
Case [SelGeo]
pi.Visible = True
Case Else
pi.Visible = False
End Select
Next pi
'turn on automatic update / calculation in the Pivot Table
pt.ManualUpdate = False
Application.ScreenUpdating = True
End Sub
Thank you very much.
You can try turning off calculation. Also, consider testing for the negative of your test... this allows for code that can run from start to end naturally without needed to Exit Sub in the middle
ThisWorkbook.Sheets("PCW_pivot").PivotTables("Pivot_table1").ClearAllFilters
If ThisWorkbook.Sheets("Graph Data").Range("SelGeo") <> WW Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Pi In pt.PivotFields("Geo").PivotItems
Select Case Pi.Name
Case [SelGeo]
Pi.Visible = True
Case Else
Pi.Visible = False
End Select
Next Pi
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End If
End Sub
I'm trying to filter a filter in a pivot table in excel using VBA, but the process is spending a lot of time. The user type in a text box and click in the submit button to start the operation. My filter has more than 2.000 values. This is the code that I use in this situation.
Does it exist a fastest way to filter?
Sub a()
Dim txt1 As String
txt1 = Worksheets("Planilha1").TextBox1.Value
If Not txt1 = "" Then
Set ws = Sheets("Planilha1")
Set pt = ws.PivotTables(1)
Set pf = pt.PageFields(1)
For Each Pi In pf.PivotItems
If Not Pi = txt1 Then
pf.PivotItems(CStr(Pi)).Visible = False
End If
Next Pi
End If
End Sub
This is significantly faster:
Sub a()
Dim txt1 As String, ws As Worksheet, pt As PivotTable, pf As PivotField, pi As PivotItem
Dim t
txt1 = "Var_1099"
If Not txt1 = "" Then
Set ws = ActiveSheet
Set pt = ws.PivotTables(1)
Set pf = pt.PivotFields("Col1")
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
pt.ManualUpdate = True
For Each pi In pf.PivotItems
pi.Visible = (pi = txt1)
Next pi
Application.Calculation = xlCalculationAutomatic
pt.ManualUpdate = False
pt.Update
Debug.Print Timer - t
End If
End Sub
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