I have a comboBox on the same sheet as a few pivot tables. The comboBox updates the pivot table filters depending on what's selected.
The problem is, when the pivot table refreshes (to set the new filters) it will active the combo box _clickfunction, starting a loop.
Is there a way around this? Why is the pivot table refresh activating the combo box?
This is the code inside the _Click event:
Private Sub cmb_SkuSelect_Click()
Dim xlSheetSort As Worksheet
Dim lastRow As Long
Dim xlCell As Range
Dim skuValue As Integer
Set xlSheetSort = ActiveWorkbook.Worksheets("Sort")
lastRow = xlSheetSort.Range("A1").End(xlDown).Row
With xlSheetSort.Range("B1:B" & lastRow)
Set xlCell = .Find(cmb_SkuSelect.Value, LookIn:=xlValues)
If Not xlCell Is Nothing Then
skuValue = xlSheetSort.Range("A" & xlCell.Row).Value
End If
End With
updatePivot skuValue
End Sub
updatePivot:
Public Sub updatePivot(ByVal sku As Integer)
Dim pt As PivotTable
Dim pt2 As PivotTable
Dim Field As PivotField
Dim Field2 As PivotField
Dim newSku As String
Set pt = Worksheets("Sku Inventory").PivotTables("SkuInfo")
Set Field = pt.PivotFields("Sku Number")
Set pt2 = Worksheets("Sku Inventory").PivotTables("InventoryInfo")
Set Field2 = pt2.PivotFields("Sku Number")
newSku = sku
With pt
Field.CurrentPage = newSku
pt.RefreshTable
End With
With pt2
Field2.CurrentPage = newSku
pt2.RefreshTable
End With
End Sub
thry like this
Public Sub updatePivot(ByVal sku As Integer)
Dim pt As PivotTable
Dim pt2 As PivotTable
Dim Field As PivotField
Dim Field2 As PivotField
Dim newSku As String
Set pt = Worksheets("Sku Inventory").PivotTables("SkuInfo")
Set Field = pt.PivotFields("Sku Number")
Set pt2 = Worksheets("Sku Inventory").PivotTables("InventoryInfo")
Set Field2 = pt2.PivotFields("Sku Number")
newSku = sku
With pt
With Field
.Orientation = xlHidden
pt.RefreshTable
.Orientation = xlPageField
.CurrentPage = newSku
End With
End With
With pt2
With Field2
.Orientation = xlHidden
pt2.RefreshTable
.Orientation = xlPageField
.CurrentPage = newSku
End With
End With
End Sub
Related
I'm trying to set-up some VBA code that will allow me to control multiple pivot tables (and data sources) with 1 slicer.
In the past, I have only needed to implement VBA code that controls 1 additional slicer, but now I am trying to set-it up to control 2 slicers and am running into issues.
Here is my code that I used in the past for controlling 1 slicer:
As a module:
Public PrevCat As String
In ThisWorkbook:
Private Sub Workbook_Open()
PrevCat = Sheet27.Range("O5").Value
End Sub
Primary code:
Option Explicit
Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
NewCat = Sheet27.Range("O5").Value
If NewCat <> PrevCat Then
Application.EnableEvents = False
Set pt = Sheet27.PivotTables("Pivot Match 2")
Set Field = pt.PivotFields("Region")
With Field
.ClearAllFilters
On Error Resume Next
.CurrentPage = NewCat
On Error GoTo 0
End With
pt.RefreshTable
PrevCat = NewCat
Application.EnableEvents = True
End If
Application.ScreenUpdating = True
End Sub
Like I said, this code works perfectly for controlling 1 additional slicer. However, I need the code to control 2 slicers. All i did was add an additional If statement, but it doesn't seem to work:
Option Explicit
Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
NewCat = Sheet27.Range("O5").Value
If NewCat <> PrevCat Then
Application.EnableEvents = False
Set pt = Sheet27.PivotTables("Pivot Match 2")
Set Field = pt.PivotFields("Region")
With Field
.ClearAllFilters
On Error Resume Next
.CurrentPage = NewCat
On Error GoTo 0
End With
pt.RefreshTable
PrevCat = NewCat
Application.EnableEvents = True
End If
If NewCat <> PrevCat Then
Application.EnableEvents = False
Set pt = Sheet27.PivotTables("Pivot Match 3")
Set Field = pt.PivotFields("Region")
With Field
.ClearAllFilters
On Error Resume Next
.CurrentPage = NewCat
On Error GoTo 0
End With
pt.RefreshTable
PrevCat = NewCat
Application.EnableEvents = True
End If
Application.ScreenUpdating = True
End Sub
Any ideas on how i can get this to work?
I'm new to VBA programming and I've run into a weird issue.
So I have a pivot table with 3 types of rows ("users", "Full Name", "Permissions").
I wrote a program to look for a certain name x in the PivotTable, and once it's found the name it looks at the following "permissions" and returns "True" if they 'Have Permissions'. Now the case when it returns "True" works fine, but for some reason every time it fails instead of returning false like I thought it would it returns #VALUE!, does anyone know why?
Public Function Dependency(x As String) As String
Dim rngRow As Range
Dim pt As PivotTable
Dim pf2Value As String
Dim pf3Value As String
pf2Value = "False"
pf3Value = "False"
Set pt = ActiveSheet.PivotTables("PivotTable1")
For Each rngRow In pt.RowRange
If pf2Value = "True" And rngRow.PivotField.Name = "Permissions" Then
If rngRow.Value = "Has Permissions" Then
pf3Value = "True"
End If
End If
If pf2Value = "True" And pf3Value = "True" And rngRow.PivotField.Name <> "Permissions" Then Exit For
If rngRow.PivotField.Name = "Full Name" And rngRow.Value = x Then
pf2Value = "True"
End If
If rngRow.PivotField.Name = "Full Name" And rngRow.Value <> x Then
pf2Value = "False"
End If
Next rngRow
Dependency = pf3Value
End Function
If I do this it does return false:
Public Function Dependency(x As String) As String
Dim rngRow As Range
Dim pt As PivotTable
Dim pf2Value As String
Dim pf3Value As String
pf2Value = "False"
pf3Value = "False"
Set pt = ActiveSheet.PivotTables("PivotTable1")
For Each rngRow In pt.RowRange
Next rngRow
Dependency = pf3Value
End Function
the issue starts when I add this line:
Public Function Dependency(x As String) As String
Dim rngRow As Range
Dim pt As PivotTable
Dim pf2Value As String
Dim pf3Value As String
pf2Value = "False"
pf3Value = "False"
Set pt = ActiveSheet.PivotTables("PivotTable1")
For Each rngRow In pt.RowRange
If pf2Value = "True" And rngRow.PivotField.Name = "Permissions" Then
End If
Next rngRow
Dependency = pf3Value
End Function
Try the code below (explanation inside the code as comments):
Public Function Dependency Code
Option Explicit
Public Function Dependency(x As String) As String
Dim pt As PivotTable
Dim ptNameFld As PivotField
Dim ptPermFld As PivotField
Dim C As Range
' set the Pivto-Table object, modify "Sheet1" with your sheet's name
Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
' set the Pivot Field "Full Name"
Set ptNameFld = pt.PivotFields("Full Name")
' set the Pivot Field "Permissions"
Set ptPermFld = pt.PivotFields("Permissions")
' loop through all rows in "Full Name" data range
For Each C In ptNameFld.DataRange.Rows
If C.Value2 Like x Then ' if the name matches "x"
' for DEBUG Only
'Debug.Print ptPermFld.DataRange(C.Row - ptPermFld.LabelRange.Row)
Dependency = ptPermFld.DataRange(C.Row - ptPermFld.LabelRange.Row) ' get the value of "Permission", of the same row
Exit For
End If
Next C
End Function
Sub TestDependency Code (to test the Function)
Sub TestDependency()
MsgBox Dependency("John Doe")
End Sub
I am trying to loop through all pivot tables in a sheet and remove all values fields in them which have the same name: "Total Net Spend" and "% Split" (see picture for reference).
I am trying the below code but it will only work on the first pivot and won't loop through all of them. How do I edit the code so that it will remove "Total Net Spend" and "% Split" columns on all the pivot tables in the sheet?
Sub Loop_Pivots()
Dim PT As PivotTable, PTField As PivotField
Set PT = Sheets("Sheet1").PivotTables("Pivot1")
With PT
.ManualUpdate = True
For Each PTField In .DataFields
PTField.Orientation = xlHidden
Next PTField
.ManualUpdate = False
End With
Set PT = Nothing
End Sub
To loop through the PivotTables try another for each loop like this
Sub Loop_Pivots()
Dim PT As PivotTable, PTField As PivotField
For Each PT In Sheets("Sheet1").PivotTables
With PT
.ManualUpdate = True
For Each PTField In .DataFields
PTField.Orientation = xlHidden
Next PTField
.ManualUpdate = False
End With
Next PT
Set PT = Nothing
End Sub
Try the code below:
Option Explicit
Sub Loop_Pivots()
Dim PT As PivotTable
Dim PTField As PivotField
For Each PT In Sheets("Sheet1").PivotTables
With PT
.ManualUpdate = True
For Each PTField In .PivotFields '<-- loop through all pivot fields
Select Case PTField.Name
Case "Total Net Spend", "% Split" '<-- if Field Name equals on of the 2 in this case
PTField.Orientation = xlHidden
End Select
Next PTField
.ManualUpdate = False
End With
Set PT = Nothing
Next PT
End Sub
I'm working with the following code:
Option Explicit
Sub checkboxfilter()
Dim cb As CheckBox
Dim oWS As Worksheet
Dim oWB As Workbook
Dim oPvt As PivotTable
Dim oPvtField As PivotField
Dim oPvtFilter As PivotFilter
Set cb = oWS("Control").Controls("YTD Filter")
If cb.Value = True Then
For Each oWS In ThisWorkbook.Worksheets
For Each oPvt In oWS
With oPvtField
.CurrentPage.Name = "Yes"
End With
Next oPvt
Next oWS
End If
End Sub
the goal is to toggle each pivot table in the workbook by a yer-to-date filter via checkbox. The code hits a snag under set cb= as an object variable or with not set. What am I missing here to get this control working? I'm also avoiding the use of a slicer.
Thanks.
That kind of control has it's own event and you should use it. Therefore:
go to sheet where you have your checkbox
set Design mode on developer tab on
double click on you check box to ...
...see something like Private Sub CheckBox1_Click()
inside that sub call your subroutine:
Private Sub CheckBox1_Click()
call checkboxfilter
End Sub
I was able to revise based on adjusting the type of format the set cb = as a .Checkboxes and ensuring at each pivot fielt was accurately called as #KazimierzJawor pointed out. Additionally with this type the value needed to be a 0 or 1 rather than True or False. Corrected and final code below.
Private Sub checkboxfilter()
Dim cb As CheckBox
Dim oWS As Worksheet
Dim oWB As Workbook
Dim oPvt As PivotTable
Dim oPvtField As PivotField
Dim oPvtFilter As PivotFilter
Set cb = Sheets("Control").CheckBoxes("YTD Filter")
If cb.Value = 1 Then
For Each oWS In ThisWorkbook.Worksheets
For Each oPvt In oWS.PivotTables
With oPvt.PivotFields("YTD?")
.CurrentPage = "Yes"
End With
Next oPvt
Next oWS
Else
For Each oWS In ThisWorkbook.Worksheets
For Each oPvt In oWS.PivotTables
With oPvt.PivotFields("YTD?")
.CurrentPage = "(All)"
End With
Next oPvt
Next oWS
End If
End Sub
Sub PivotFilter()
Dim pvtF As PivotField
Dim pvtI As PivotItem
Dim StartDate As Date
Dim EndDate As Date
Dim pvtIVal As String
StartDate = DateValue("Jan 1, 2018")
EndDate = Application.WorksheetFunction.EoMonth(Date, 0)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Create Month").ClearAllFilters
Set pvtF = ActiveSheet.PivotTables("PivotTable1").PivotFields("Create Month")
For Each pvtI In pvtF.PivotItems
If (pvtI <> "(blank)") Then
If DateValue(pvtI) >= StartDate And DateValue(pvtI) <= EndDate Then
pvtI.Visible = True
Else
pvtI.Visible = False
End If
Else
pvtI.Visible = False
End If
Next pvtI
End Sub
I have an Excel workbook with several hundred pivot tables. All of the pivot tables are using data from an SSAS cube. The tables are all basically structured the same way, but they have different "location" filters. What I want to do is have code that will change a "date" filter for all of the tables so that I do not need to manually update each of the tables. (No, slicers will not work for me). I'm very much new to using VBA, so I'm a bit at a loss. I found this code, which I thought might work, but all it does for me is clear the filters on the other tables...possibly because I'm pulling from an external source? Any help would be greatly appreciated.
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(pfMain.Name)
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(pi.Name).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
Kindly try the following code.
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`enter code here`
Dim pf As PivotField
Dim pi As PivotItem
Dim pvfilter as string
On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target
Application.EnableEvents = False
Application.ScreenUpdating = False
pvfilter = InputBox("Enter the pivot filter string")
For Each pfMain In ptMain.PageFields
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(pfMain.Name)
With pf
.ClearAllFilters
.CurrentPage = pvfilter
End With
Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt
Next ws
Next pfMain
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I would suggest you update this code as subroutine and run this macro whenever you need to apply a filter to pivot tables instead of directly using the code in pivot update event.
Sub Test()
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 pvfilter As String
On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target
Application.EnableEvents = False
Application.ScreenUpdating = False
pvfilter = InputBox("Enter the pivot filter string")
For Each pfMain In ptMain.PageFields
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(pfMain.Name)
With pf
.ClearAllFilters
.CurrentPage = pvfilter
End With
Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt
Next ws
Next pfMain
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub