Access, Excel 2010 - Copy Worksheet to End of Book (run-time error '91'

Garr

New Member
Joined
Jan 17, 2010
Messages
7
First, thanks for reading. Allow me to set up the project concept.

I have an Access database that stores athletic contest officials information. To pay the officials, I have to use an Excel cover sheet created by my company. I've managed a way to get Access to open the worksheet and drop the data from the current record on my form, but I'd like to have a one-button press to generate ALL of my cover sheets on their own tabs in a single Excel Workbook.

Objectives:
Open the workbook
do until EOF
Copy the sole sheet at the end of all the sheets
Rename the sheet based on data in the current record
Copy the current record's data onto the new worksheet
next record

Here's my current code. It is *not* cycling through the recordset yet because I can't even get it to work correctly for a single record.

Code:
Private Sub cmdGenerateDIVs_Click()

    'objects
    Dim objXLApp As Excel.Application
    Dim objXLBook As Excel.Workbook
    Dim objWSTemplate As Excel.Worksheet
    Dim objWS As Excel.Worksheet
    
    'variables
    Dim strRemitAdvice As String
    Dim strDescription As String
    Dim strInvoiceNo As String
    Dim strSheetName As String
    
    'object setup
    Set objXLApp = CreateObject("Excel.Application")
    Set objXLBook = objXLApp.Workbooks.Open("O:\ATH_BIZ\2012-2013\01 Men's Sports\MVB - Men's Volleyball\OfficialsContracts\MVBOfficialsDIVs.xlsx")
    Set objWSTemplate = objXLBook.Sheets(1)
      
    objXLApp.Application.Visible = True
    
    'saving the document as a test document
    objXLBook.SaveAs "O:\ATH_BIZ\2012-2013\01 Men's Sports\MVB - Men's Volleyball\OfficialsContracts\" & Me.OfficialLast & " " & Me.OfficialFirst & " TEST"
    
    strRemitAdvice = "*IPFW vs " & Me.AwayTeam_TeamAbbreviation & " " & Me.MatchDate & " " & Me.OfficialTypeAbbr
    strDescription = "Men's Volleyball Official " & strRemitAdvice
    strInvoiceNo = "SRVC" & Format(Month(Me.MatchDate), "00") & Format(Day(Me.MatchDate), "00") & Format(Year(Me.MatchDate), "YYYY")
    strSheetName = Me.OfficialLast & Format(Month(Me.MatchDate), "00") & Format(Day(Me.MatchDate), "00")
    
    'creating a copy of the main DIV and renaming it
    objWS = objXLBook.Worksheets(objWSTemplate.Name).Copy(After:=objXLBook.Sheets(Worksheets.Count))
    objWS.Name = "Test"
        
    'placing the data from the form into the excel spreadsheet
    With objXLApp.ActiveSheet
        .Range("D2").Value = Me.VendorNumber
        .Range("F1").Value = Me.TIN
        .Range("A4").Value = Me.AddrName
        .Range("A5").Value = Me.Address
        .Range("A6").Value = Me.CSZ
        .Range("A10").Value = strRemitAdvice
        .Range("D13").Value = Me.OfficialTypePay
        .Range("D14").Value = Me.RoundTrip
        .Range("D15").Value = Me.Mileage
        .Range("B18").Value = strDescription
        .Range("F35").Value = Date
        .Range("G16").Value = strInvoiceNo
    End With

End Sub

When I run that code, it copies the sheet to the end, but cannot move forward. I get a run-time error, and I can't figure out why.

Run-Time error '91': Object variable or With block variable not set

I've searched for about two hours trying to make this work, and I can't find anything that helps. Can anyone assist? What further do you need from me?
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Okay. I don't know what I did. . .but now it worked. I'm stumped.

Thanks for your help guys. Plugging through made it jive. Let's see if I can replicate the result!
 
Upvote 0
The code I posted doesn't compile because there should be no brackets around the After argument of Copy as Crystal has indicated.
 
Upvote 0
glad you are making progress

if you do not have
Option Explicit
at the top of your module, add it --- then compile again

If you have any misspelled or undeclared variables, the compiler will tell you what they are ;)
 
Upvote 0
Thanks again to both of you! You are my heroes of the week! I'm working out some other minor bugs, but if I turn the error handling off, it works without an issue. Which is odd. Because when I put the error handler back in, it runs, displays no msgbox, and then closes everything.

That's probably a task for another day!
 
Upvote 0
Re: Access, Excel 2010 - Copy Worksheet to End of Book (run-time error '91')

Well, here's the working, fully functional code. So that anyone who might be having the same type of situation can benefit from a working model.

This code successfully:

Opens an excel workbook with a single template sheet
Opens a query recordset
Creates a copy of the template tab for every record
Populates several pieces of data onto the new tab
Closes it all down

Code:
Option Compare Database

Option Explicit

Private Sub cmdGenerateDIVs_Click()

'~~~~~~~~~~~~~~~~~~~~~~
   'set up Error Handler
   On Error GoTo Proc_Err
'~~~~~~~~~~~~~~~~~~~~~~


    'objects
    Dim objXLApp As Excel.Application
    Dim objXLBook As Excel.Workbook
    Dim objWSTemplate As Excel.Worksheet
    Dim objWS As Excel.Worksheet
    Dim db As Database
    Dim rst As DAO.Recordset
    
    'variables
    Dim strRemitAdvice As String
    Dim strDescription As String
    Dim strInvoiceNo As String
    Dim strSheetName As String
    Dim strWBName As String
        
    ' setting filename
    strWBName = "MVBOfficialsDIVs.xlsx"
       
    'object setup
    Set objXLApp = CreateObject("Excel.Application")
    Set objXLBook = objXLApp.Workbooks.Open("O:\ATH_BIZ\2012-2013\01 Men's Sports\MVB - Men's Volleyball\OfficialsContracts\MVBOfficialsDIVs.xlsx")
    Set objWSTemplate = objXLBook.Sheets(1)
    Set db = CurrentDb()
    Set rst = db.OpenRecordset("qryContractDetails")
    
    'don't see the magic
    objXLApp.Application.Visible = False
    
    'cycle through the recordset
    Do While Not rst.EOF
    
        'creating a copy of the main DIV and renaming it
        objXLBook.Worksheets(objWSTemplate.Name).Copy After:=objXLBook.Sheets(objXLBook.Worksheets.Count)
        Set objWS = objXLBook.Sheets(objXLBook.Worksheets.Count)
        
        'setting strings
        strSheetName = rst.Fields("OfficialLast") & Format(rst.Fields("MatchDate"), "mmdd")
        strRemitAdvice = "*IPFW vs " & rst.Fields("AwayTeam.TeamAbbreviation") & " " & rst.Fields("MatchDate") & " " & rst.Fields("OfficialTypeAbbr")
        strDescription = "Men's Volleyball Official " & strRemitAdvice
        strInvoiceNo = "SRVC" & Format(rst.Fields("MatchDate"), "mmddyyyy")
        
        'naming the sheet
        objWS.Name = strSheetName
        
        'placing the data from the form into the excel spreadsheet
        With objWS
            .Range("D2").Value = rst.Fields("VendorNumber")
            .Range("F2").Value = rst.Fields("TIN")
            .Range("A4").Value = rst.Fields("AddrName")
            .Range("A5").Value = rst.Fields("Address")
            .Range("A6").Value = rst.Fields("CSZ")
            .Range("A10").Value = strRemitAdvice
            .Range("D13").Value = rst.Fields("OfficialTypePay")
            .Range("D14").Value = rst.Fields("RoundTrip")
            .Range("D15").Value = rst.Fields("Mileage")
            .Range("B18").Value = strDescription
            .Range("F35").Value = Date
            .Range("G16").Value = strInvoiceNo
        End With
        
        'go to the next record
        rst.MoveNext
        
    Loop
    
    rst.Close

'~~~~~~~~~~~~~~~~~~~~~~
Proc_Exit:
   On Error Resume Next
       Set objWS = Nothing
       Set objWSTemplate = Nothing
       Set rst = Nothing
       Set db = Nothing
       If Not objXLBook Is Nothing Then
          'close without saving
          objXLBook.Close SaveChanges:=True
          Set objXLBook = Nothing
       End If
       If Not objXLApp Is Nothing Then
          objXLApp.Quit
          Set objXLApp = Nothing
       End If
   Exit Sub 'or Exit Function

Proc_Err:
   MsgBox Err.Description & " ERROR " & Err.Number & "   cmdGenerateDIVs", , "ERROR " & Err.Number & "   cmdGenerateDIVs"
   Resume Proc_Exit
   
End Sub

Thanks again for all your help, guys. Though I dumped a lot of time into making this work, it will easily save me more in not having to hand complete all these forms.
 
Upvote 0
Re: Access, Excel 2010 - Copy Worksheet to End of Book (run-time error '91')

Glad you got it working. Here are some comments on your code:

instead of
rst.Fields("VendorNumber")
you can do this:
Code:
  rst!VendorNumber

instead of:
Set rst = Nothing
do this:
Code:
      If Not rst Is Nothing Then
          rst.Close
          Set rst= Nothing
       End If

since you are not modifying data in the recordset, when you open it, you should do this:
Code:
    db.OpenRecordset("qryContractDetails", dbOpenSnapshot)

this way, if something else wants to open the recordset while your code is running, it will not collide

after
Resume Proc_Exit

I would add
Code:
Resume

this way, if the code does get an error, you can press Ctrl-Break to Debug the code. Then, right-click on Resume and choose Set Next Statement. Then press F8 to execute it, which will take you to the statement that caused the problem

instead of

Dim db As Database
use
Code:
Dim db As dao.Database

</pre>
 
Last edited:
Upvote 0
I realize your code is doing this:
rst.close

which is probably why you didn't close it in the exit code ... but remember, your exit code could be executed after an error, in which case all your statements will not be done*

* ... unless you forget Exit Sub at the end of the exit code and you get an error message with err.number = 0 ... this means there is no error, so it got there sequentially --still happens to me once in awhile ;)
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,219
Messages
6,123,680
Members
449,116
Latest member
HypnoFant

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top