Run-Time Error 1004 On Pivot Table Macro

Question

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 accomplish the same thing or help me identify what's causing the code to Run Time on me. I looked through the code and checked out all of the variables being referenced and they look correct. I did notice the workbook has 90 sheets and I'm not sure if thats a factor. 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))

Answer 1

Not sure but try this

 

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 & "]"))

If it still doesn't work then, I would like to see the workbook if possible?

---

Sid (A good exercise for the Heart is to bend down and help another up)

Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.

Answer 2

Thanks. I placed the code into the macro and it's still providing the same error. I'm not sure there is a problem with the visual basic at all the way it's written. I'm able to use a back-up file which is the exact replica, when I copy and save the back-up over the old file the macro runs with no problem. Except the next morning it returns the Run-Time 1004 error again. The Run-Time also comes back intemittently through the day and the current workaround is to copy and paste the back-up over the old file and just run it again. I'm unable to explain this behavior at all. The file and back-up are identical and the code is unchanged. Why it runs intermittently through the day and not at all on first run in the morning is baffling me.

 

I don't mind sharing the workbook. Just let me know the best way. Thanks.

Answer 3

Hi

Given that your backup restore procedure fixes the issue. The only things that the code refers to that could change are

The contents of Update!X1 or Update!X2 or the names of the Pivot tables ("PivotTable1").

Maybe it's this?

 

---

G North MCT

Answer 4

I agree. I checked the contents of Update!X1 and Update!x2 and they look correct. Each pivot table in the file is also correctly named "PivotTable1".  

I'm grasping at straws and wondering if it's just one of those random excel gremlins that will force me to manually re-create the file and re-write the code from an entirely new workbook. It's frustrating running across a problem like this.  

Answer 5

Hi

Looking OK could be the issue.  If for example X2 appears as 1 in the worksheet it could be 1.2 formatted to 0 decimal places.  This would have a serious knock on effect in what the code is trying to acheive.  Same could be said of text entries with trailing spaces.

Are the contents of either X1 or X2 the results of formulae?

---

G North MCT

Answer 6

Can you do me a small favor? Just test this code for me. I have just added few lines in your code for error trapping. Could you tell me what message box do you get?

 

Private Sub ChangeReportDate_Click()
 Dim Mnth As String, dt As String, sCurrentSheet As String, ShtName As String
 Dim Sht As Worksheet

 Windows("Data.xls").Activate
 
 On Error GoTo Whoa
 
 Mnth = Worksheets("Update").Range("x1")
 dt = Worksheets("Update").Range("x2")

 sCurrentSheet = ActiveSheet.Name

 For Each Sht In Application.Worksheets
  ShtName = Sht.Name
  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]")
 Next Sht
 Exit Sub
Whoa:
 MsgBox ShtName
End Sub

---

Sid (A good exercise for the Heart is to bend down and help another up)

Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.

Answer 7

Update!X1 contains the following formula ="["&W1&"]"

Update!X2 contains the following formula ="["&W2&"]"

Update!W1 contains =TEXT(D3,"mmmm")

Update!W2 contains =TEXT(D3,"mm/dd/yy")

D3 is a cell the user has to place the date they wish to show into the file. The cell is formatted to date mm/dd/yy

 

 

Answer 8

Siddarth I ran the code you provided. I get a message box with the name of the first sheet.

Answer 9

Gr8.

Since you cannot upload your workbook, let's do few tests one by one to eliminate the source of error. Now please run this code for me. In the code below, replace "Sheet1" with the name of the first sheet.

Sub PVTName()
 Dim PVTName As PivotTable
 
 For Each PVTName In Sheets("Sheet1").PivotTables
 MsgBox PVTName.Name
 Next
End Sub

What message(s) do you get?

---

Sid (A good exercise for the Heart is to bend down and help another up)

Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.

Answer 10

It brings up a Message Box that provides the name PivotTable1

Answer 11

Hi

I must admit I was expecting X2 to be the day number.   Just on the off chance the mm/dd/yyyy format is the same as the format expected from the data. 

There doesn't look to be any issuse with the formula producing the values of X1 and X2.  It also explains why Siddarths first suggestion added the [ ].  (I was thinking that too.)

To remove the potential for the Pivot table name being the issue you could recode as below assuming you only have the one pivot on the sheet.

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))

to

ActiveSheet.PivotTables(1).CubeFields(20).TreeviewControl.Drilled = _
Array(Array(""), Array("[Date Interval].[Year].&[2011]"), Array( _
"[Date Interval].[Year].&[2011]." & Mnth), Array("[Date Interval].[Year].&[2011]." & Mnth & "." & dt))

---

G North MCT

Answer 12

G I just tried your alternative and it is providing the message caught by Sid's error handler.

 

Do you think I should build a small file from scratch, where recreate a couple of tabs and re-write the vba? I'm wondering if this could be some kind of file corruption since the file is a couple of years old and has 90 tabs.

Answer 13

I think my problem has to do with the cubefield. I just changed the cubefield from 20 to 4 and the code ran a few sheets before erroring again with Sid's error handling message.

Answer 14

Sorry for not replying earlier.

I am in a Live Meeting at the moment :)

@G North: You guessed it right :)

@Qaspec: The next thing I was going to try was the cubefields :) But I guess, you have already discovered that.

---

Sid (A good exercise for the Heart is to bend down and help another up)

Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.

Answer 15

Ok, there were a few sheets with the wrong pivot table name so now after changing the cube field to 4 (i have no idea why it was set to 20)  the macro below works. I just need to make it ignore the Update sheet on the error handler since it does not have a pivot table.

 

Private Sub ChangeReportDate_Click()
 Dim Mnth As String, dt As String, sCurrentSheet As String, ShtName As String
 Dim Sht As Worksheet

 Windows("Data.xls").Activate
 
 On Error GoTo Whoa
 
 Mnth = Worksheets("Update").Range("x1")
 dt = Worksheets("Update").Range("x2")

 sCurrentSheet = ActiveSheet.Name

 For Each Sht In Application.Worksheets
  ShtName = Sht.Name
  Sht.Activate
 
  'Change drill down date of pivot table in each tab
  ActiveSheet.PivotTables("PivotTable1").CubeFields(4).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]")
 Next Sht
 Exit Sub
Whoa:
 MsgBox ShtName
End Sub

 

 

Answer 16

Also please note that the error trapping that i was doing was for that particular section. You might want to change it to something like

Replace this

Whoa:
 MsgBox ShtName

by

Whoa:
  If Len(Trim(ShtName)) <> 0 Then
    MsgBox Err.Description & vbNewLine & _
    "Error caused in Sheet " & ShtName
  Else
    MsgBox Err.Description
  End If

---

Sid (A good exercise for the Heart is to bend down and help another up) Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.

Answer 17

Yes the cubefield was becoming a hot favourite for me too.  Not sure why this is the case, maybe the Cube has been rebuilt.

It migt be worth finding out the identity of field 4 and refer to it by it's name.  That way the code will work if the fileds get messed around again.  This might be useful.

Set objNewSheet = Worksheets.Add

objNewSheet.Activate

intRow = 1

For Each objCubeFld In Worksheets("Sheet1").PivotTables(1).CubeFields


    objNewSheet.Cells(intRow, 1).Value = objCubeFld.Name

    intRow = intRow + 1



Next objCubeFld

---

G North MCT

Answer 18

This is a good error handler. How do I make it ignore the "Update" sheet?

 

Also, thank you both for your help working me through this issue. It is greatly appreciated.

Answer 19

Like this?

Whoa:
  If ShtName = "Update" Then Exit Sub
  If Len(Trim(ShtName)) <> 0 Then
   MsgBox Err.Description & vbNewLine & _
   "Error caused in Sheet " & ShtName
  Else
   MsgBox Err.Description
  End If

---

Sid (A good exercise for the Heart is to bend down and help another up) Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.

Answer 20

In fat when you are looping through every worksheet, do a check if the current worksheet is not "Update" and then run the code for example

 For Each Sht In Application.Worksheets
  shtname = Sht.Name
  
  If shtname <> "Update" Then
    Sht.Activate
    
    '~~> Rest of code
  End If
 Next Sht

---

Sid (A good exercise for the Heart is to bend down and help another up) Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.