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]
 

...and you actually call [highlight #FCE94F]xlCreate[/highlight]?

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
I added activate code before the Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=goXl.Workbooks(sT_WrkBk).Sheets.Count code and now I am getting the run-time error 9 the line I added.
The source workbook is open I can see it on my desktop. The target workbook is also open.

Code:
Public Function xlCopyWorksheets(sFileLoc As String, sUCI As String, sS_WrkBk As String, sT_WrkBk As String, sS_ShtNm As String, sT_ShtNm As String)
    Dim wrkbk As Workbook
    Dim wrksht As Worksheet
    Dim sFileType As String
    'Open destination workbook
    sFileType = "xls"
    Call xlOpen(sFileLoc, sUCI, sT_WrkBk, sT_ShtNm, sFileType)
     'Added activate statement
    [Blue] goXl.Workbooks(sS_WrkBk).Activate [/Blue]
    'Sheets(1).Copy After:=Sheets(Sheets.Count)
    'goXl.Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=Workbooks(sT_WrkBk).Sheets(Workbooks(sT_WrkBk).Sheets.Count)    'orig line works for one worksheet

    'goXl.Sheets(sS_ShtNm).Copy After:=goXl.Workbooks(sT_WrkBk).Sheets.Count
    
    'Puts sheet after last sheet
    'goXl.Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=goXl.Workbooks(sT_WrkBk).Sheets(goXl.Workbooks(sT_WrkBk).Sheets.Count)
    Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=goXl.Workbooks(sT_WrkBk).Sheets.Count
    'Save active workbook
    goXl.ActiveWorkbook.Save
    'Close Active workbook
    goXl.ActiveWorkbook.Close
End Function
 


Is this at all related to OHV's ovservation that xlOpen calls xlCreate AGAIN, thur resetting goXl?

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Within the xlopen procedure the xlcreate procedure gets called.

Code:
Public Function xlOpen(sFileLoc As String, sUCI As String, sFile As String, sSheet As String, sFileType As String)
' *******************************************************
' *** THIS FUNCTION OPENS AN EXCEL TEMPLATE *************
' *******************************************************
'Call xlOpen(sFileLoc, sClient, sFile, sSheet, sFileType)
    Dim dBase As DAO.Database
    Dim sFileExt As String
    Dim sFileOpen As String
    Set dBase = CurrentDb
    'Set on error in case there are no tables
    On Error GoTo Errhandler
    sFileOpen = sFileLoc & sFile
    On Error Resume Next
    ' OPEN EXCEL INSTANCE
    Call xlCreate
    If goXlPresent = True Then
        'OPEN EXCEL
        With goXl
            .Workbooks.Open FileName:=sFileOpen
            'Select Sheetname for information to go into.
            .Sheets(sSheet).Select
            '.Sheets & "(""& sSheet & "")" & .Select
            .Cells(1, 1).Select
        End With
    End If
    Exit Function
Errhandler:
    ' Display the error number and the error text.
    MsgBox "Error # " & Err & " : " & Error(Err)
End Function
 
Seems like vba317 rplied in the wrong thread ...
 
If I take away the goXl from the activate code I don't get an error, but the run-time error 9 shows up at the copy code

Code:
'goXl.Workbooks(sS_WrkBk).Sheets(sS_ShtNm).Copy After:=goXl.Workbooks(sT_WrkBk).Sheets(goXl.Workbooks(sT_WrkBk).Sheets.Count)
 


You are destroying the goXl reference to any previously opened workbook!

Hence your recurring missing reference issues!

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
In your xlOpen procedure, replace this:
Call xlCreate
with this:
If goXl Is Nothing Then Call xlCreate

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Sorry PHV I got confused.
So once the second workbook is opened and the goXl reference is destroyed for the first workbook if I set goXL again would I destroy the link to the second worksheet?
 

You only need set the Excel appliction object [highlight #FCE94F]ONE TIME[/highlight]!

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Thanks PHV and Skip for your patience and wisdom. I added PHV's code to the xlopen procedure and now this procedure works !!!!!!
I would have to call you both Jedi masters!
 
I am sorry I have messed up this thread with the previous thread. I am currently getting a run-time error 1004 Application -defined or object -defined error on the following line:

Code:
Public Function xlPivotRefresh(sSheetName As String)
    Dim iBotRow As Integer
    Dim rDataRange As Range
    Dim SourceWorksheet As Worksheet
    Dim SourceRange As Object
    Call xlCalcBotRow(iBotRow)
    With goXl.ActiveWorkbook
 [Blue]       Set SourceRange = .Worksheets("DATA").Range("A1:" & iBotRow).CurrentRegion [/Blue]
        .Names.Add _
                Name:="Database", _
                RefersTo:="='" & SourceRange.Parent & "'!" & SourceRange.Address

        .Worksheets("Summary").PivotTables(1).ChangePivotCache _
                goXl.ActiveWorkbook.PivotCaches.Create( _
                SourceType:=xlDatabase, _
                SourceData:="Database", _
                Version:=xlPivotTableVersion10)
    End With
 
'Remove Comand Bars
Application.CommandBars("PivotTable").Visible = False
'Remove Pivottable Field List
ActiveWorkbook.ShowPivotTableFieldList = False
End Function
 

What's the [highlight #FCE94F]VALUE[/highlight] of [highlight #FCE94F]iBotRow[/highlight]?

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
What about this ?
Set SourceRange = .Worksheets("DATA").Range("A1:[!]A[/!]" & iBotRow).CurrentRegion
Or even simpler:
Set SourceRange = .Worksheets("DATA").Range("A1").CurrentRegion

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
PHV, That worked !
Now I get a Runtime error 438 object doesnt support this property or method error on the the next line:
Code:
.Names.Add _
                Name:="Database", _
                RefersTo:="='" & SourceRange.Parent & "'!" & SourceRange.Address
 

Code:
'
           .Names.Add _
                Name:="Database", _
                RefersTo:="='" & SourceRange.Parent[highlight #FCE94F].Name[/highlight] & "'!" & SourceRange.Address




Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Skip, Thanks
It now fails the next line error 438 object doesnt support this property or method

Code:
.Worksheets("Summary").PivotTables(1).ChangePivotCache _
                goXl.ActiveWorkbook.PivotCaches.Create( _
                SourceType:=xlDatabase, _
                SourceData:="Database", _
                Version:=xlPivotTableVersion10)
 

See if [highlight #FCE94F]this[/highlight] will work rather than ActiveWorkbook (which may or may not be the correct workbook), which is the workbook in which Summary exists.

Other than that, I'd look at xlPivotTableVersion10: do you KNOW that that is the correct Excel constant?
Code:
'
          .Worksheets("Summary").PivotTables(1).ChangePivotCache _
                [highlight #FCE94F].Worksheets("Summary").Parent[/highlight].PivotCaches.Create( _
                SourceType:=xlDatabase, _
                SourceData:="Database", _
                Version:=xlPivotTableVersion10)


Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
I am not 100% sure if excel 2003 is version 10 so I took it out. I had to add goXL. before goXl.Worksheets("Summary").Parent.PivotCaches.Create( or I would get a compile error.

I am still getting the error 438
 
Turn on your macro recorder and record changing the source data range reference for this pivot table.

Then observe your recorded code.

Post back with your recorded code for help customizing.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top