I have a spreadsheet and I created a sub function (please see below) to make a call to update specific pivot tables. One particular pivot table ("DataModel") has text as values, so, when I created that pivot table I added it to the data model then did a "Add Measure" and created a line code =CONCATENATEX(DataModel,[DataValue],”, “) so I can pivot on the text value.
Anyway, when I run the code below, it updates all the pivot tables I want except for the one made from the data model. Does anyone know how I can use Excel VBA to automate the pivot table made from the data model?
---- Call to module ---
Call RefreshPivots("DataModel")
---- Excel VBA Code ---
Public Sub RefreshPivots(ByVal sheetName As String)
Dim sheetExists As Boolean
sheetExists = False
For Each ws In Worksheets
If ws.Name = sheetName Then sheetExists = True
Next ws
If sheetExists Then
Sheets(sheetName).Visible = True
Sheets(sheetName).Activate
For Each pivotTab In ActiveSheet.PivotTables
pivotTab.PivotCache.Refresh
Next pivotTab
End If
End Sub
Use the RefreshTable method of the PivotTable object instead.
By the way, the pivot table worksheet does not need to be visible in order to refresh the pivot table.
Also, it's considered good programming practice to follow the 'Dedication of Duty' principle. It basically says that a function should be dedicated to do one thing, and nothing else.
So, for example, RefreshPivots should only refresh the pivot tables. Checking whether the worksheet exists should be done before calling your function to update the pivot tables.
I have re-written your code accordingly...
Option Explicit
Sub test()
Dim worksheetName As String
worksheetName = "DataModel"
If Not WorksheetExists(worksheetName) Then
MsgBox "'" & worksheetName & "' not found!", vbExclamation
Exit Sub
End If
RefreshWorksheetPivots worksheetName
'make worksheet visible, if so desired
End Sub
Public Function WorksheetExists(ByVal worksheetName As String) As Boolean
Dim ws As Worksheet
For Each ws In Worksheets
If UCase(ws.Name) = UCase(worksheetName) Then 'case-insensitive comparison
WorksheetExists = True
Exit Function
End If
Next ws
WorksheetExists = False
End Function
Public Sub RefreshWorksheetPivots(ByVal worksheetName As String)
Dim pt As PivotTable
For Each pt In Worksheets(worksheetName).PivotTables
pt.RefreshTable
Next pt
End Sub
Related
The macro works if I select a single date.
If I select multiple items on one pivot table, it then updates the rest of the pivot tables by selecting every option in the filter dropdown.
Example of code:
Private Sub Worksheet_PivotTableUpdate _
(ByVal Target As PivotTable)
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
I want this code to run automatically when a date is changed in a pivot table on a particular sheet, either by selecting a single date or multiple. I have about 10 pivot tables on this sheet (they all have their own data source).
When I select one date, say the 01/01/2022 (with select multiple items unchecked) it will update all the other pivot tables accordingly.
When I select one date with "select multiple items" checked, it will select every date/option from the dropdown filter.
What can be done to have the macro run and select multiple dates on all the other pivot tables?
I need to be able to select either a single date or a date range such as a whole month.
I'm not sure what all of your code is doing with the filters and what not, but here's a basic macro that refreshes all pivotables in the workbook (thisWorkBook). Make sure this is placed in a Module, not the worksheet tab.
Sub refreshAllPV()
Dim p As PivotTable, ws As Worksheet, wkbk As Workbook
Set wkbk = ThisWorkbook 'better to set this a parameter when calling
For Each ws In wkbk.Worksheets
For Each p In ws.PivotTables
p.PivotCache.Refresh
Next p
Next ws
End Sub
From here, you just need to capture the proper event. When I run this test code, it fires on both multiple and single filter changes. You might want to condition the action to only launch the macro if a particular pivot table is modified.
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Const nNameOfDisiredPivot = "PivotTable1" 'or whatever it is. Make sure case is accurate
If Target.Name = nNameOfDisiredPivot Then
MsgBox "Macro called for change to: " & Target.Name 'included just for testing to see when event is called.
Call refreshAllPV
End If
End Sub
I am trying to use a nested for loop that parses through all the worksheets (1st For Loop) and parses through each Pivot table in each worsksheets (2nd For loop). Within 2nd For loop, I am trying to change the pivot filter value based on a combobox selection.
Below is the code, but it does not loop through the 2nd for loop.
Private Sub bo_combobox_Change()
Dim a As String
Dim pt As PivotTable
Dim ws As Worksheet
If bo_combobox.Value <> "" Then
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ThisWorkbook.PivotTables
With pt.PivotFields("Objective")
.ClearAllFilters
.CurrentPage = bo_combobox.Value
Debug.Print (.CurrentPage)
End With
Next pt
Next ws
End If
End Sub
Your (asked about) problem is with
For Each pt In ThisWorkbook.PivotTables
The Workbook.PivotTables collection is not what it seems:
From the documentation
The PivotTables property of the Workbook object does not return all the PivotTable objects in the workbook; instead, it returns only those associated with decoupled PivotCharts. However, the PivotTables method of the Worksheet object returns all the PivotTable objects on the worksheet, irrespective of whether they are associated with decoupled PivotCharts.
That said, there are several other issues
You have For Each ws In ActiveWorkbook.Worksheets then don't use ws
You are referenceing both ActiveWorkbook and ThisWorkbook. These may or may not be the same workbook
Your code, refactoed
Private Sub bo_combobox_Change()
Dim a As String
Dim pt As PivotTable
Dim ws As Worksheet
Dim wb as Workbook
Set wb = ActiveWorkbook 'or ThisWorkbook, or select a book by any means you choose
If bo_combobox.Value <> vbNullString Then
For Each ws In wb.Worksheets
For Each pt In ws.PivotTables
' remainder of your code
'...
Next pt
Next ws
End If
End Sub
I have a combobox (drop down list) that is populated with the names of all the sheets in the workbook. When I select one of them, it activates the selected sheet.
This was working until I copied it in another workbook and did some changes.
Here's the code I use to populate the combobox (which still works):
Sub fillAllCombos()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name <> PVTSHEET Then Call fillCombobox(ws.Name)
Next
End Sub
Sub fillCombobox(wsName As String)
Dim ws As Worksheet
Dim oCmbBox As Object
Set oCmbBox = ThisWorkbook.Sheets(wsName).Shapes("cmbSheet")
oCmbBox.ControlFormat.RemoveAllItems
For Each ws In ThisWorkbook.Sheets
oCmbBox.ControlFormat.AddItem ws.Name
Next
End Sub
Here's how I capture the event:
Sub CmbSheet_Change()
Dim oCmbBox As Object
Set oCmbBox = ActiveSheet.Shapes("cmbSheet")
With oCmbBox.ControlFormat
If .Value <> "" Then
ActiveWorkbook.Sheets(.Value).Activate
.ListIndex = 0
End If
End With
End Sub
The event-capture macros are in the sheet where the combobox is located.
In my search for answers I have also tried CmbSheet_Click()but same result.
I've named the combobox as in the image:
**Edit: Application.EnableEvents = True
It looks as if you have a Form Control Combobox. You can assign any parameter-less public sub to it, but you have to do this assignment manually. Just right-click on the control and select "Assign Macro...".
It's different for an ActiveX Control where the assignment is done via its name.
I have a pivot table in my Sheet1 connected to external sources which is also an excel sheet. All i am trying to do is to get a date and time stamp whenever someone refreshes pivot table.
I get an error Object doesn't support this property or method.
Private Sub Refresh_Click()
Dim PT As PivotTable
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
For Each PT In WS.PivotTables
PT.RefreshTable
WS.Sheets("Month-to-Date").Range("P5") = TimeValue(Now)
Next PT
Next WS
End Sub
The problem is that WS is a Worksheet and a Worksheet does not support another Worksheet as a property.
Worksheets are properties of Workbooks so
ThisWorkbook.Sheets("Month-to-Date").Range("P5") = TimeValue(Now)
Fixes the problem
There is a fancy built-in event in Excel VBA for this. In the worksheet of the pivot table, select the event PivotTableUpdate (Event Documentation):
As far as probably there would be more than 1 pivot tables on the worksheet, it is a good idea to check which one is the refreshed one, using its name:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Select Case Target.Name
Case "PivotTable2"
Debug.Print "Write date somewhere "; Format(Now, "DD-MM-YYYY")
Case Else
Debug.Print "Not PivotTable2"
End Select
End Sub
"DateStamp" is obtained through Format(Now, "DD-MM-YYYY") and printed to the immediate window (Ctrl+G). Instead of printing there, it is a possible option to write it to a server or to a separate worksheet, getting the last cell of a row like this:
Case "PivotTable2"
Worksheets(2).Cells(lastCell, 1) = Format(Now, "DD-MM-YYYY")
I often find that with pivot tables i end up with tons of worksheets from new sheets being created via pivot table drill downs. I thought a great macro would be to display a small userform in the upper right corner of all new sheets created from pivot tables allowing the user to easily delete the sheet and return to the pivot table. However, I cant figure out how to trigger the macro. Any ideas? Basically the macro would need to be automatically triggered anytime a new sheet is created from drilling down in a pivot table.
With out getting too complex, you are probably looking for something like this...
Under "ThisWorkbook" add the following code:
EDITED
This was working for me:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Detect_Pivot(Sh) Then
Sh.Activate
frmSheetOptions.Show
End If
End Sub
Function Detect_Pivot(wsNew As Worksheet) As Boolean
Dim wb As Workbook
Dim pvt As PivotTable
Dim bNew As Boolean
Dim i As Integer
i = 0
bNew = True
Set wb = ThisWorkbook
For Each pvt In wsNew.PivotTables
i = i + 1
s = Split(pvt.SourceData, "!")
sName = s(0)
If wsNew.Name = sName Then
bNew = False
Exit For
End If
Next
If i > 0 Then Detect_Pivot = bNew
End Function
Inside the frm you want to display:
Private Sub cmdHide_Click()
frmSheetOptions.Hide
End Sub
Private Sub cmdDelete_Click()
ActiveSheet.Delete
frmSheetOptions.Hide
End Sub
Private Sub UserForm_Initialize()
frmSheetOptions.lblSheetName = ActiveSheet.Name
End Sub
To start an event whenever a new sheet is created, you can use the following example (an answer from Tim Williams). However, I'm not sure how to tell if the new sheet was created from a pivot table. The drill-down might be an event triggered by the pivot table, in which case, maybe you can apply this method to find it. It would take some investigation.
Private WithEvents app As Excel.Application
Sub Init()
Set app = Application 'start capturing events
End Sub
Private Sub app_NewWorkbook(ByVal Wb As Workbook)
Debug.Print "New"
End Sub
Private Sub app_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Debug.Print "Before close: " & Wb.Name
End Sub
Private Sub app_WorkbookOpen(ByVal Wb As Workbook)
Debug.Print "Open: " & Wb.Name
End Sub