Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Run time error 1004 PivotTableWizard method of worksheet class failed

Status
Not open for further replies.

vba317

Programmer
Mar 5, 2009
708
US
I have written a module that gives me the run time error 1004. I am not sure which one of my variables is incorrect.
Thanks for any help provided Tom

The error is highlighted in Blue
The worksheet Has two tabs on it.
Tab1 is called Summary
Tab2 is called Data
The Worksheet Name is AHS_Cnts
The columns that have data in them are A - E on tab DATA
Currently the last row is 2931


Code:
Public Function xlPivotRefresh(sSheetName As String)
    Dim iBotRow As Integer
    Dim sDataArea As String
    Dim pvt As PivotTable
'    For Each pvt In ActiveSheet.PivotTables
'        MsgBox pvt.Name & ":" & pvt.TableRange1
'
    'Count Last Row of DATA Sheet
    Call xlCalcBotRow(iBotRow)
    sDataArea = "DATA!$A$1" & ":" & "$E$" & iBotRow
    'sSheetName = "DATA"
    With goXl.ActiveWorkbook
        .Worksheets(sSheetName).Activate
    End With
    'Rename Pivot Table Data with new range
    'C5 means column 5 of the pivot table
    ActiveWorkbook.Names.Add Name:="PivotData", RefersToR1C1:="=DATA!R1C1:R" & iBotRow & "C5"
    With goXl.ActiveSheet
        .PivotTables("PivotTable1").RefreshTable
    End With
    'Rename wizard range
    With goXl.ActiveSheet
[Blue]  .PivotTableWizard SourceType:=xlDatabase, SourceData:="DATA!R1C1:R" & iBotRow & "C5", TableDestination:="Summary", TableName:="PivotTable1" [\Blue]
        .PivotTables("PivotTable1").PivotCache.Refresh
    End With
    'Next
    'Remove Pivottable Field List
    ActiveWorkbook.ShowPivotTableFieldList = False
End Function


[\code]
 
What is the value of sSheetName when the procedure is called ?
What is the code of xlCalcBotRow ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 

hi,

Why go to all that bother just to refresh you PT?

Convert your Source Data to a Structured Table. This process with NAME your table with the default name of Table1. You can rename it anything that's legal for a table to be called.

This in the PT Options > Data > Change Data Source, substitute the Structured Table table name.

No VBA required, just a REFRESH!

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
BTW, you are using the incorrect wizard code as TableDestination is not part of an update to an existing PivotTable.

In fact, I wouldn't be using the PT Wizard just to modify the source data range!

Code:
    ActiveSheet.PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:="[highlight #FCE94F]Table1[/highlight]", Version _
        :=xlPivotTableVersion12)

But as I previously stated, I wouldn't actually use this code at all, as [highlight #FCE94F]Table1[/highlight] defines the source range no matter how often the row content/count has changed and that reference can be changed on the sheet!

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
The xlCalcBotRow function is

the sheetname is Summary when the procedure is called
Code:
Public Function xlCalcBotRow(iBotRow As Integer)
' ***************************************************************************
' *** THIS FUNCTION CALCULATES THE BOTTOM ROW OF DATA  **********************
' ***************************************************************************
'Call xlCalcBotRow(iBotRow)
'Calculate Bottom Row
    iBotRow = Cells(Rows.Count, "A").End(xlUp).Row
End Function
 
Skip,
I know I can do a refresh the way you spoke about. But this code applies to 45 pivot tables in the reports that I am working with. That's why I wanted to automate the process.
 
Key is making each source table a structured table.

Code:
Private sub Workbook_SheetActivate(byval sh as object)
   Dim PT as PivotTable

   For each PT in sh.pivottables
      PT.pivotcache.refresh
   Next
End sub

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Skip, your refresh function does not cause an error but my ranges are not reset to the new ranges. I have tries something new and now I am getting a runtime error 13 Type mismatch.
The error is highlighted in Blue.
The Data worksheet is called DATA
The Pivot table worksheet is called Summary


Code:
Public Function xlPivotRefresh(sSheetName As String)
    Dim iBotRow As Integer
    Dim sDataArea As String
    Dim pvt As PivotTable
    Dim sSource As String
    Dim DataRange As Range
    Dim wsDATA As Worksheet
    Dim wsWorksheet As Worksheet
    Dim wsPvtTable As Worksheet
    
'    For Each pvt In ActiveSheet.PivotTables
'        MsgBox pvt.Name & ":" & pvt.TableRange1
'
    'Count Last Row of DATA Sheet
    Call xlCalcBotRow(iBotRow)
    'sDataArea = "DATA!$A$1" & ":" & "$E$" & iBotRow
    'sSheetName = "DATA"
   ' sSheetName = "Summary"
  
    
    
    'Set pvt = ActiveSheet.PivotTables(1)
    
    sSheetName = "DATA"
    
    
      With goXl.ActiveWorkbook
        .Worksheets(sSheetName).Activate
    End With
    
[Blue]    Set wsDATA = goXl.Worksheets("DATA") [\Blue]
    Set DataRange = wsDATA.Range("A2:E" & iBotRow)
    'Set wsPvtTable = Worksheets("Summary")
    
      
    goXl.PivotTableSelection = Sheets("DATA").Range(DataRange).CurrentRegion.Address(True, True, xlR1C1, True)
    
'    With goXl.ActiveWorkbook
'        .Worksheets(sSheetName).Activate
'    End With
    'Rename Pivot Table Data with new range
    'C5 means column 5 of the pivot table
    ActiveWorkbook.Names.Add Name:="PivotData", RefersToR1C1:="=OFFSET('DATA'!R2C1,0,COUNTA('DATA'!C1,COUNTA('DATA'!E2))"
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="PivotData").CreatePivotTable TableDestination:="Summary", TableName:="PivotTable1"
    goXl.ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    
    ' ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _
        "DATA!R1C1:R2931C5"
   
    'Rename wizard range
    ', TableDestination:="Summary", TableName:="PivotTable1"
    
    'sSource = Range("DATA!R1C1:R" & iBotRow & "C5")
    
  
    
   '
    'sSource = Range("A2:E" & iBotRow)
'    With goXl.ActiveSheet
'        .PivotTableWizard SourceType:=xlDatabase, SourceData:=DataRange
'       ' .PivotTables("PivotTable1").PivotCache.Refresh
'    End With
    'Next
    'Refresh Table
  
    With goXl.ActiveSheet
        .PivotTables("PivotTable1").RefreshTable
    End With
   'Remove Comand Bars
    Application.CommandBars("PivotTable").Visible = False
     'Remove Pivottable Field List
    ActiveWorkbook.ShowPivotTableFieldList = False
End Function
 
HOLY MACKREL! Why do you still have all this code? That is totally unnecessary, IF you make your source data a structured table and use the table name in the PT Options > Data > Change Data Source ONE TIME.

All you need is 4 LOC!

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
BTW...

[Blue] Set wsDATA = goXl.Worksheets("DATA") [[highlight #729FCF]/[/highlight]Blue]

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 

If you don't want to take advantage of Structure Table features, then you could simply give your source data a named range like Database, which Excel PTs like...
Code:
Public Function xlPivotRefresh()
    Dim SourceRange As Range
    
    With goXl.ActiveWorkbook
        
        Set SourceRange = .Worksheets("DATA").Range("A2").CurrentRegion
        
        .Names.Add _
            Name:="Database", _
            RefersTo:="='" & SourceRange.Parent & "'!" & SourceRange.Address
            
        .Worksheets("Summary").PivotTables(1).ChangePivotCache _
            goXl.ActiveWorkbook.PivotCaches.Create( _
                SourceType:=xlDatabase, _
                SourceData:="Database", _
                Version:=xlPivotTableVersion12)
    End With
    
End Function


Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Skip,
Thanks for your help so far.
I am currently getting a run time error 13 Type mismatch on the following line.
Set SourceRange = .Worksheets("DATA").Range("A2").CurrentRegion

The worksheet is open and the datasheet DATA is activated.
Any suggestions?
Tom
 
Ah,
Code:
Dim SourceRange As [highlight #FCE94F]Object[/highlight]

or

Code:
Dim SourceRange As [highlight #FCE94F]Excel.Range[/highlight]



Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
I tried both when I change SourceRange to either one I get a run-time error 1004. Could this be a refernece issue?

Currently I have
Visual Basic for applications
Microsoft Access 10.0 Object Library
OLE automation
Microsoft DAO 3.6 Object Library
Microsoft ActiveX data objects 2.7 library
Microsoft ADO ext 2.8 for DDL and security
Microsoft Jet and replication objects 2.6 library
Microsoft Visual Basic for Applictions extensibility 5.3
Microsoft office Web components
Microsoft excel 10.0 Library
Microsoft Data Formatting object library 6.0 (SP6)
 
I assume you mean the Tools > References in the VBA Editor.

ALSO, you show nowhere in your code where you Set goxl.


Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Sorry for the omission.
This code is on the top of my modules
Public goXl As Excel.Application ' The Excel Object variable

Yes I did mean the referneces you would see at Tools> references
 

Where have you SET the goXl Excel application object instance after having declared it?

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 

Every object variable needs to be SET, else it's value is NOTHING.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
I found the code that does set the reference.

Code:
Public Function xlCreate()
' *****************************************************
' *** THIS FUNCTION CREATES A NEW INSTANCE OF EXCEL ***
' *****************************************************
'Call xlCreate
    On Error Resume Next
    goXlPresent = True
    Set goXl = CreateObject("Excel.Application")
    If goXl Is Nothing Then    ' Check if Excel is installed
        goXlPresent = False
    Else
        goXl.Visible = True    ' If there, make it visible
    End If
End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top