ashley1984
New Member
- Joined
- Mar 31, 2018
- Messages
- 32
- Office Version
- 365
- Platform
- Windows
Hi,
I'm trying to refresh a Pivot Table and select the next column of data in the Values section of the PivotTable Field. I have 104 weeks of rolling data that gets updated weekly. I drop in the data to a data dump sheet and refresh a Pivot table. I have managed to get the VBA to refresh the pivot table but can't get it to unselect the previous week and select the new week of data that has been added. I have made the pice of code bold where I am stuck
Sub RefreshAndModifyPivotTables()
Dim ws As Worksheet
Dim pt1 As PivotTable
Dim pt2 As PivotTable
Dim dataRange As Range
Dim newField As Range
Dim fieldName As String
' Set the worksheet where the pivot tables are located
Set ws = ThisWorkbook.Sheets("Pivot") ' Replace "YourSheetName" with the actual sheet name
' Define the data range for the pivot tables
Set dataRange = ws.Range("A1:DE1000") ' Update the range as needed
' Check if "TPNB_LEVEL" pivot table exists and refresh it
On Error Resume Next
Set pt1 = ws.PivotTables("TPNB_LEVEL")
On Error GoTo 0
If Not pt1 Is Nothing Then
' Refresh the "TPNB_LEVEL" pivot table
pt1.RefreshTable
' Unselect the current selected PivotField (if any)
For Each ptField In pt1.PivotFields
ptField.Orientation = xlHidden
Next ptField
' Get the latest field to add to the pivot table
Set newField = dataRange.Cells(1, dataRange.Columns.Count).End(xlToLeft).Offset(0, 1)
fieldName = newField.Value
' Add the latest field to "TPNB_LEVEL" pivot table
If Not pt1.PivotFields(fieldName) Is Nothing Then
pt1.PivotFields(fieldName).Orientation = xlDataField
End If
End If
' Check if "SUB-GROUP_LEVEL" pivot table exists and refresh it
On Error Resume Next
Set pt2 = ws.PivotTables("SUB-GROUP_LEVEL")
On Error GoTo 0
If Not pt2 Is Nothing Then
' Refresh the "SUB-GROUP_LEVEL" pivot table
pt2.RefreshTable
End If
End Sub
I'm trying to refresh a Pivot Table and select the next column of data in the Values section of the PivotTable Field. I have 104 weeks of rolling data that gets updated weekly. I drop in the data to a data dump sheet and refresh a Pivot table. I have managed to get the VBA to refresh the pivot table but can't get it to unselect the previous week and select the new week of data that has been added. I have made the pice of code bold where I am stuck
Sub RefreshAndModifyPivotTables()
Dim ws As Worksheet
Dim pt1 As PivotTable
Dim pt2 As PivotTable
Dim dataRange As Range
Dim newField As Range
Dim fieldName As String
' Set the worksheet where the pivot tables are located
Set ws = ThisWorkbook.Sheets("Pivot") ' Replace "YourSheetName" with the actual sheet name
' Define the data range for the pivot tables
Set dataRange = ws.Range("A1:DE1000") ' Update the range as needed
' Check if "TPNB_LEVEL" pivot table exists and refresh it
On Error Resume Next
Set pt1 = ws.PivotTables("TPNB_LEVEL")
On Error GoTo 0
If Not pt1 Is Nothing Then
' Refresh the "TPNB_LEVEL" pivot table
pt1.RefreshTable
' Unselect the current selected PivotField (if any)
For Each ptField In pt1.PivotFields
ptField.Orientation = xlHidden
Next ptField
' Get the latest field to add to the pivot table
Set newField = dataRange.Cells(1, dataRange.Columns.Count).End(xlToLeft).Offset(0, 1)
fieldName = newField.Value
' Add the latest field to "TPNB_LEVEL" pivot table
If Not pt1.PivotFields(fieldName) Is Nothing Then
pt1.PivotFields(fieldName).Orientation = xlDataField
End If
End If
' Check if "SUB-GROUP_LEVEL" pivot table exists and refresh it
On Error Resume Next
Set pt2 = ws.PivotTables("SUB-GROUP_LEVEL")
On Error GoTo 0
If Not pt2 Is Nothing Then
' Refresh the "SUB-GROUP_LEVEL" pivot table
pt2.RefreshTable
End If
End Sub
VBA Code: