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 TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

For Each Loop works once then gives error 91 2

Status
Not open for further replies.

sxschech

Technical User
Jul 11, 2002
1,033
US
Upfront, letting you know I might not have explained well or need to provide more code for context...

This question is using MS-Access to run vba to modify an excel sheet.

Found this code to refresh data in pivot at
It seems to work fine without error the first time I run it. Normally I only have to run the code once and only discovered the issue when doing some testing to adjust other things in the spreadsheet unrelated to the pivot, when I click the button to run the code a second time, it stops on this line with the error.

Run-time error 91 Object or variable with block not set

Code:
                Case "Submittal Data"
                    .Cells(2, 1).CopyFromRecordset rs
                    [highlight #FCE94F]For Each chPivot In ActiveWorkbook.PivotCaches[/highlight]
                        chPivot.Refresh
                    Next chPivot
                    .Range("H2:H" & lastRow + 1).ClearContents
            End Select

This code is only run one time per click and I finish it off by setting things to nothing.
If I completely close/exit MS-Access and reopen it. It is fine again to run once, but not more than once before the error happens.
 
What do you get when you add a line in the code:

[tt]MsgBox ActiveWorkbook.PivotCaches.Count
For Each chPivot In ActiveWorkbook.PivotCaches[/tt]

You may also check if you refer to proper workbook before refreshing the cache:
[tt]MsgBox ActiveWorkbook.Name[/tt]

combo
 
If this is your code from Access, you (should) have some code above to reference an [red]Excel object[/red], right?

Code:
With [red]xlApp[/red]
    ...[blue]
    .Cells(2, 1).[/blue]CopyFromRecordset rs
    ...
End With

This is weird with Excel.
If you have this in your code: [tt]Cells(2, 1).[/tt] (See the missing period before Cells?), Excel will let you run it first time just fine, but then complains about the code you have just run. Nice.

So, I would check how you declared [tt]chPivot[/tt], and fully qualify it.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
combo, first time through:
Debug.Print ActiveWorkbook.Name displays: SubmittalsOverdueDataLeadChart_Template.xlsx
Debug.Print ActiveWorkbook.PivotCaches.Count displays: 1

second time error 91 when it gets to the debug statement

Code:
Case "Submittal Data"
                    .Cells(2, 1).CopyFromRecordset rs
                    [highlight #FCE94F]Debug.Print ActiveWorkbook.Name[/highlight]
                    Debug.Print ActiveWorkbook.PivotCaches.Count
                    For Each chPivot In ActiveWorkbook.PivotCaches
                        chPivot.Refresh
                    Next chPivot
                    .Range("H2:H" & lastRow + 1).ClearContents
            End Select

Here is the full code if that helps.
Code:
Function FormatExcel_Recordset(filename As String, qry As String, Optional Customize As String)
'Output data to excel and apply existing
'format of the "template" which may include
'conditional formatting
'20181204
'refresh pivot table and chart
'[URL unfurl="true"]https://www.automateexcel.com/vba/refresh-pivot-tables/[/URL]
'20230828
'change the where clause for data to > 0
'20230828
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim stsql As String
    Dim objapp As Object
    Dim wb As Object
    Dim ws As Object
    Dim Rng As Object
    Dim stCustomize As String
    Dim stMgr As String
    Dim stDiscShort As String
    Dim stCol As String
    Dim lastRow As Integer
    Dim lastCol As Integer
    Dim fname As Variant
    Dim FNameExists As Boolean
    Dim chPivot As PivotCache
    Dim i As Integer
    Dim yesno
    
    Set objapp = CreateObject("Excel.Application")     'Excel Not Running
    
    objapp.Visible = True
    Set wb = objapp.Workbooks.Open(filename, True, False)
    
    If Len(Customize) > 0 Then
        stCustomize = FileNameNoExt(Customize)
    End If
    
    For Each ws In wb.Worksheets
        'Debug.Print ws.Name
        With ws
            .Activate
            Set rs = CurrentDb.OpenRecordset(qry)   'qryLetters_Excel
            
            rs.MoveLast
            rs.MoveFirst
            
            lastRow = rs.RecordCount + 1
            lastCol = .Range("A1").CurrentRegion.Columns.Count
            Select Case ws.Name
                Case "Summary"
                    'Insert rows to push total row to end without overwriting
                    .Range("3:" & lastRow + 1 & "").EntireRow.Insert
                    .Cells(3, 1).CopyFromRecordset rs
                    .Range("E2:F2").Copy
                    'paste formula for difference and percent
                    .Range("E2:F" & lastRow + 1).PasteSpecial xlPasteAll
                    .Application.CutCopyMode = False
                    'Apply format to all data rows
                    .Range("A2:F2").Copy
                    .Range("A2:F" & lastRow + 1).PasteSpecial xlPasteFormats
                    .Application.CutCopyMode = False
                    'Remove demo row which format was based upon
                    .Rows(2).Delete
                    'For second loop, change query to allow pasting of detail rows
                    qry = "qryOverDueOutstandingList_ExportData"
                Case "Data"
                    Set qd = EditQryDef(qry)
                    stsql = Replace(qd.SQL, "ORDER BY ", "WHERE DisciplineLeadData.DaysLate > 0 ORDER BY ")
                    Set rs = CurrentDb.OpenRecordset(stsql)
                    .Cells(2, 1).CopyFromRecordset rs
                    .Range("H2:H" & lastRow + 1).ClearContents
                Case "Submittal Data"
                    .Cells(2, 1).CopyFromRecordset rs
                    Debug.Print ActiveWorkbook.Name
                    Debug.Print ActiveWorkbook.PivotCaches.Count
                    For Each chPivot In ActiveWorkbook.PivotCaches
                        chPivot.Refresh
                    Next chPivot
                    .Range("H2:H" & lastRow + 1).ClearContents
            End Select
            .Range("A1").Select
        End With
        lastRow = 0
        lastCol = 0
    Next
    
exit_function:
    wb.Worksheets(1).Activate
    'prepopulate file name so user knows whether this
    'is a course or conference spreadsheet.  Name can
    'be modified to another name as appropriate
    '20160405
    If stCustomize <> "ResponsesToJPBLetters" Then
        Customize = Replace(Customize, ".xlsx", Format(Date, "_yyyymmdd") & ".xlsx")
        Customize = Replace(Customize, "-", "_")
    End If
    If stCustomize = "" Then
        Customize = Replace(Replace(filename, ".xlsx", Format(Date, "_yyyymmdd") & ".xlsx"), "Template_", "")
        Customize = Replace(Customize, "Documents\ExcelFiles", "Downloads")
    End If
    FNameExists = False
fnameSave:
    Do While FNameExists = False
        
        fname = GetSaveFilename(Customize)
fnameReplace:
        If fname = "" Then
            'no file chosen or user hit cancel
            '20170612
            Exit Do
        ElseIf Dir(fname) = "" Then
            wb.SaveAs fname, FileFormat:=51
            FormatExcel_Recordset = fname
            FNameExists = True
        ElseIf fname = False Then
            MsgBox "File will not be saved", vbOKOnly + vbInformation, "Cancel SaveAs"
            wb.Close savechanges:=False
            
            FNameExists = True
        Else
            objapp.Visible = False
            yesno = MsgBox("File " & fname & " already exists.  Would you like to REPLACE this file? " & vbCrLf & vbCrLf & "Press No to choose another name; Cancel to quit without saving.", vbYesNoCancel, "File Exists")
            objapp.Visible = True
            If yesno = vbCancel Then
                wb.Close savechanges:=False
                FNameExists = True
            ElseIf yesno = vbYes Then
                Kill fname
                GoTo fnameReplace
            Else
                GoTo fnameSave
            End If
        End If
    Loop
    rs.Close
    Set rs = Nothing
    Set qd = Nothing
    objapp.Quit
    Set chPivot = Nothing
    Set objapp = Nothing
End Function
 
You are worrking in Access, yes?

In that case, I am surprised that

ActiveWorkbook.PivotCaches (or trying to access anyu other properties or methods of ActiveWorkbook)

works at all!

Unless, of course, you have a global object declared as ActiveWorkbook somewhere else, are assigning it to an excel application's ActiveWorkbook, and is being referenced and dereferenced elsewhere.


You'd be best off in the short term to be explicxit, and use

objapp.ActiveWorkbook

In the long run, see if you can hunt down the declaration and usage of ActiveWorkbook with a view to eliminating it if you can; this is a great example of why global variables are to be used sparingly
 
You don't need ActiveWorkbook in your function. After [tt]Set wb = objapp.Workbooks.Open(filename, True, False)[/tt] you can work directly with wb, so:
[tt]For Each chPivot In wb.PivotCaches[/tt].

I guess that you have reference to Excel (so why excel objects and constants work). You may benefit from early binding, for instance:
[tt]Dim objapp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Rng As Excel.Range
Set objapp = New Excel.Application[/tt]


combo
 
sxschech does have an early binding to Excel. Otherwise the declaration:[tt]
Dim chPivot As PivotCache[/tt]
would error.

So, we have here combination of early and late binding, but why?

And nowhere in the code I can see:
Code:
With objapp
    ...
End With
to explicitly reference Excel object.
That's why, in my opinion, Excel is saying: I will let you pass once, but after that - an error.
Happened to me many times.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Here's an illustyration of what I think is happening (and early or late binding makes no difference):

Code:
[COLOR=blue]Option Compare Database
Option Explicit

Public ActiveWorkbook As Object

' Early or late binding makes no difference to this
Public Sub Demo()
    Set ActiveWorkbook = CreateObject("Excel.Application").workbooks.Add [COLOR=green]' possibly in some startup code somewhere, so only run once[/color]
       
    minimalexample
    
    ActiveWorkbook.Close
    Set ActiveWorkbook = Nothing [COLOR=green]' possibly in some cleanup code, but this can be run multiple times without error, so could happily sit ion your main processing loop[/color]
    
    minimalexample
     
End Sub

Public Sub minimalexample()
    Dim objapp As Object
    Set objapp = CreateObject("Excel.Application")
    Debug.Print ActiveWorkbook.Name
End Sub[/color]
 
sxschech said:
second time error 91 when it gets to the debug statement

[blue]Try:[/blue]

Code:
Case "Submittal Data"
    .Cells(2, 1).CopyFromRecordset rs
    [highlight #FCE94F]Debug.Print [blue]objapp.[/blue]ActiveWorkbook.Name[/highlight]
    ...

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
The error is because of Excel is not an active window. Tested in Word VBA with reference to Excel:
Code:
Sub test()
Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
' Application.Activate
MsgBox ActiveWorkbook.Name
objExcel.Quit
Set objExcel = Nothing
End Sub
The code works, Word displays workbook name (under Excel window on top). If Application.Activate is uncommented, Word is on top, code breaks with run-time error 91.


combo
 
combo,

Your code gives "Variable not defined" error on line:[tt]
MsgBox [highlight #FCE94F]ActiveWorkbook[/highlight].Name[/tt]
It needs:[tt]
MsgBox [blue]objExcel.[/blue]ActiveWorkbook.Name
[/tt]

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Andy, do you have Excel referenced? ActiveWorkbook is in the library, so should be recognised.

combo
 
No, I do not have Excel referenced, since your code refers to a late binding (I guess)

With an early binding (Excel referenced), I would expect to see:[tt]
Dim objExcel As New Excel.Application[/tt]

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Wow, great discussion. Thanks for the input.

Andy, looks like your last post sorted it out. After adding objapp. before ActiveWorkbook, I was able to run the code multiple times without the error.

I did a search [CTRL+F] for Current Project and that was the only spot where ActivWorkbook exists, so my thought is that it only affected that one item...unless as Andy mentioned there are other statements that should be prefixed with objApp or use
Andy said:
With objapp
...
End With

Sometimes hard for me to discern which statements need more prefixes (excuse if terminology not correct) between native excel vba and running excel code indirectly via access vba.

Revised code in green
Code:
Case "Submittal Data"
    .Cells(2, 1).CopyFromRecordset rs
    Debug.Print objapp.ActiveWorkbook.Name
    Debug.Print objapp.ActiveWorkbook.PivotCaches.Count
    For Each chPivot In [highlight #73D216]objapp.[/highlight]ActiveWorkbook.PivotCaches
        chPivot.Refresh
    Next chPivot
    .Range("H2:H" & lastRow + 1).ClearContents
End Select

Regarding early/late binding, yes I have both because in the beginning I used early binding and then down the road tried to switch to late binding and then sometimes copied bits and pieces from older code or the web to get things working and so things got a bit muddled.
 
Looks like my screen refreshed whilst I was clicking on the post, meant to star Andy's post from 29 Aug 23 14:53 rather than 29 Aug 23 18:18 which must have come in while preparing and reviewing my reply.
 
sxschech said:
Regarding early/late binding, yes I have both

it is kind of tricky to switch, unless you have a way to fully compile your code and assure you do have [tt]Option Explicit[/tt]
With an early binding, all Excel's constants like [tt]xlNone, xlDiagonalDown, xlEdgeBottom, xlContinuous[/tt], etc. will work just fine. But as soon as you change to a late binding (and eliminate reference to Excel), you may crash all over unless you change all of those constants to [tt]-4142, 5, 9, 1[/tt] respectively.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Andrzejek said:
No, I do not have Excel referenced, since your code refers to a late binding (I guess)
I need the reference to Excel even with late binding, as I use ActiveWorkbook in the code. There is no ActiveWorkbook when Excel is not active, so run-time error 91.


combo
 
Contributing a new line of code before the refresh since I figured out how to adjust the range of the pivot table due to the latest refresh having less rows than the template and that caused the chart to display a literal blank. This is a hard coded statement per the comments, so it would need to be modified if dealing with multiple pivot charts or if the sheet containing the pivot is on another tab.

Code:
'Adjust the range for the pivot table and refresh
    'Since this is from an excel file being used like a template, we know there is only
    'one pivot table as well as the sheet and range which
    'is why that is hard coded in the replace statement as R663
    'otherwise, would need to further identify the sheet, the
    'pivottable name and the range in order not to change the
    'source data of multiple pivots.  
'Found the range via chPivot.SourceData
    '20230829
    For Each chPivot In objapp.ActiveWorkbook.PivotCaches        
        chPivot.SourceData = Replace(chPivot.SourceData, "R663", "R" & lastRow)
        chPivot.Refresh
    Next chPivot
 
>After adding objapp. before ActiveWorkbook

Something I advised way back near the beginning ...
 
strongm, sorry for the oversight, you are correct. <smiley>ashamed icon</smiley> I think due to the additional discussions and examples, it didn't register that you provided the original solution. Hopefully it is rectified by the star. If not, please advise.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top