I've taken over a position for someone else and there seems to be issues with certain macro's in their workbooks. Some I've been able to fix. This one looks like it is attempting to set the pivot table tree to open for the specific day for the pivot table on each sheet. I'm using XL07 with VB 6.5.1053
I was hoping someone might know alternate code to accomlpish the same thing or help me identify what's causing the code to Run Time on me. Thanks for any help.
Private Sub ChangeReportDate_Click()
Windows("Data.xls").Activate
Dim Mnth As String
Mnth = Worksheets("Update").Range("x1")
Dim dt As String
dt = Worksheets("Update").Range("x2")
Dim Sht As Worksheet
Dim sCurrentSheet As String
sCurrentSheet = ActiveSheet.Name
For Each Sht In Application.Worksheets
Sht.Activate
'Change drill down date of pivot table in each tab
ActiveSheet.PivotTables("PivotTable1").CubeFields(20).TreeviewControl.Drilled = _
Array(Array(""), Array("[Date Interval].[Year].&[2011]"), Array( _
"[Date Interval].[Year].&[2011]." & Mnth), Array("[Date Interval].[Year].&[2011]." & Mnth & "." & dt))
'Hide specified years
ActiveSheet.PivotTables("PivotTable1").PivotFields("[Date Interval].[Year]"). _
HiddenItemsList = Array( _
"[Date Interval].[Year].&[2002]", "[Date Interval].[Year].&[2003]", _
"[Date Interval].[Year].&[2004]", "[Date Interval].[Year].&[2005]", _
"[Date Interval].[Year].&[2006]", "[Date Interval].[Year].&[2007]", _
"[Date Interval].[Year].&[2008]")
On Error GoTo dontupdate
Next Sht
dontupdate: Exit Sub
Worksheets(sCurrentSheet).Activate
ActiveWorkbook.Save
Application.Range("A1").Select
End Sub
Section Highlighted by VB Editor
'Change drill down date of pivot table in each tab
ActiveSheet.PivotTables("PivotTable1").CubeFields(20).TreeviewControl.Drilled = _
Array(Array(""), Array("[Date Interval].[Year].&[2011]"), Array( _
"[Date Interval].[Year].&[2011]." & Mnth), Array("[Date Interval].[Year].&[2011]." & Mnth & "." & dt))