locked
Run-Time Error 1004 On Pivot Table Macro RRS feed

  • 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))
    • Moved by Max Meng Wednesday, August 3, 2011 1:37 AM (From:Excel IT Pro Discussions)
    Tuesday, August 2, 2011 8:40 PM

Answers

  • 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
    • Marked as answer by Qaspec Wednesday, August 3, 2011 3:58 PM
    Wednesday, August 3, 2011 3:01 PM
  • 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.

    • Marked as answer by Qaspec Wednesday, August 3, 2011 3:58 PM
    Wednesday, August 3, 2011 3:40 PM
  • 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

     

     

    • Marked as answer by Qaspec Wednesday, August 3, 2011 3:58 PM
    Wednesday, August 3, 2011 3:52 PM
  • 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.
    • Marked as answer by Qaspec Wednesday, August 3, 2011 4:54 PM
    Wednesday, August 3, 2011 4:19 PM

All replies

  • 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.


    Wednesday, August 3, 2011 7:58 AM
  • 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.

    Wednesday, August 3, 2011 12:21 PM
  • 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

    Wednesday, August 3, 2011 12:54 PM
  • 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.  

    Wednesday, August 3, 2011 1:25 PM
  • 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
    Wednesday, August 3, 2011 1:51 PM
  • 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.

    Wednesday, August 3, 2011 1:58 PM
  • 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

     

     

    Wednesday, August 3, 2011 2:26 PM
  • Siddarth I ran the code you provided. I get a message box with the name of the first sheet.
    Wednesday, August 3, 2011 2:32 PM
  • 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.




    Wednesday, August 3, 2011 2:39 PM
  • It brings up a Message Box that provides the name PivotTable1
    Wednesday, August 3, 2011 2:44 PM
  • 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
    • Marked as answer by Qaspec Wednesday, August 3, 2011 3:58 PM
    Wednesday, August 3, 2011 3:01 PM
  • 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.

    Wednesday, August 3, 2011 3:06 PM
  • 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.
    Wednesday, August 3, 2011 3:30 PM
  • 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.

    • Marked as answer by Qaspec Wednesday, August 3, 2011 3:58 PM
    Wednesday, August 3, 2011 3:40 PM
  • 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

     

     

    • Marked as answer by Qaspec Wednesday, August 3, 2011 3:58 PM
    Wednesday, August 3, 2011 3:52 PM
  • 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.
    Wednesday, August 3, 2011 3:56 PM
  • 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
    Wednesday, August 3, 2011 4:06 PM
  • 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.

    Wednesday, August 3, 2011 4:12 PM
  • 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.
    Wednesday, August 3, 2011 4:16 PM
  • 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.
    • Marked as answer by Qaspec Wednesday, August 3, 2011 4:54 PM
    Wednesday, August 3, 2011 4:19 PM