Code failing on second pass

[Bill the Cat]

I am running an Access Database script to populate 4 separate Excel reports based on 4 employees' inputs to the database. When I run the button, the first Excel sheet is populated and sorts fine. When the script loops, fills the spreadsheet, and goes to sort, it fails on the following line:



Columns("A:G").Sort key1:=Range("G:G"), order1:=xlAscending, Header:=xlYes

I receive:

Runtime Error 1004

"Method 'Range" of object '_Global' failed


I can remove the column sort line and the script continues to run successfully. Why is it failing here? I've tried every permutation of sorting I know...

[Welshgasman]

You would need to show the rest of the code?

[Bill the Cat]

Sorry about that. The Qry_NormalAssignments provides the 4 employee names for the outer Do loop. Each employee gets their own spreadsheet. The inner do loop grabs their filtered data from Qry_ObjectiveValidationSample and then it dumps it to a spreadsheet, sorts based on the sorting number, and saves the spreadsheet. The first pass through, the first assessor's spreadsheet works fine, but the second pass through fails with the above referenced error. I stripped out the part that fills the data into the spreadsheet because it still fails the same way without data in there.

Private Sub Btn_Assessor_Samples_Click()Dim SQLxFilter As String
Dim vaData As Variant
Dim rst As ADODB.Recordset


Set db = CurrentDb
Set rs = db.OpenRecordset("Qry_NormalAssignments")
rs.MoveFirst
Do While Not rs.EOF
    xAssessor = rs.Fields(0).value
    MsgBox xAssessor, vbOKOnly
        
       
        'Get Recordset
        Set rst = CurrentProject.Connection.Execute("Select * from Qry_ObjectiveValidationSample WHERE ASSESSOR =" & Chr(34) & xAssessor & Chr(34))
        If rst.BOF Then
        Else
           'Count records
            NumOfRecords = 0
            rst.MoveFirst
            Do While Not rst.EOF
                NumOfRecords = NumOfRecords + 1
                rst.MoveNext
            Loop
       
            'Set up Assessor Excel Workbook
            Dim oExcel          As Object
            Dim oExcelWrkBk     As Object
            Dim oExcelWrSht     As Object
            Dim iCols           As Integer
            Dim SpecificRecord As Integer
            Dim xSort As Integer
            
            Set oExcel = CreateObject("Excel.Application")
            oExcel.ScreenUpdating = True
            oExcel.Visible = True
            Set oExcelWrkBk = oExcel.Workbooks.Add()
            Set oExcelWrSht = oExcelWrkBk.Sheets(1)
            oExcelWrSht.Cells(1, 1).value = "Family"
            oExcelWrSht.Cells(1, 2).value = "Requirement Number"
            oExcelWrSht.Cells(1, 3).value = "Requirement"
            oExcelWrSht.Cells(1, 4).value = "Objective Number"
            oExcelWrSht.Cells(1, 5).value = "Objective Text"
            oExcelWrSht.Cells(1, 6).value = "Objective Validation"
            oExcelWrSht.Cells(1, 7).value = "Sorting"
            With oExcelWrkBk.ActiveSheet.Range("1:1")
                .EntireRow.Font.Bold = True
                .WrapText = True
            End With
            With oExcelWrkBk.ActiveSheet.Range("A:A")
                .EntireColumn.ColumnWidth = 8
            End With
            With oExcelWrkBk.ActiveSheet.Range("B:B")
                .EntireColumn.ColumnWidth = 12
                .WrapText = True
            End With
            With oExcelWrkBk.ActiveSheet.Range("C:C")
                .EntireColumn.ColumnWidth = 30
                .WrapText = True
            End With
            With oExcelWrkBk.ActiveSheet.Range("D:D")
                .EntireColumn.ColumnWidth = 9
                .WrapText = True
            End With
            With oExcelWrkBk.ActiveSheet.Range("E:E")
                .EntireColumn.ColumnWidth = 30
                .WrapText = True
            End With
            With oExcelWrkBk.ActiveSheet.Range("F:F")
                .EntireColumn.ColumnWidth = 70
                .WrapText = True
            End With
            xRow = 2
            
            Columns("A:G").Sort key1:=Range("G:G"), order1:=xlAscending, Header:=xlYes
            Columns("G:G").Delete
            oExcelWrkBk.SaveAs ("C:\temp\Excel_" & xAssessor & ".xlsx")
            MsgBox "data exported", vbOKOnly
            oExcel.Quit
        
            rst.Close
            Set rst = Nothing
            Set oExcelWrSht = Nothing
            Set oExcelWrkBk = Nothing
            Set oExcel = Nothing
    
    
        End If
    rs.MoveNext
Loop
End Sub

[Welshgasman]

I would prefix the Columns lines with

oExcelWrkBk.ActiveSheet.
or
oExcelWrSht

I would also not keep creating the excel app every time.
You can find out how many records with a MoveLast then RecordCount

[Bill the Cat]

I would prefix the Columns lines with

oExcelWrkBk.ActiveSheet.
or
oExcelWrSht

I'll give that a try... edit to add. That failed too.

I would also not keep creating the excel app every time.

Yeah. I thought about moving that outside my Do loop

You can find out how many records with a MoveLast then RecordCount

I tried. It kept returning -1

[Welshgasman]

Where does it get used?
Plus where does the data get added?

Edit: OK, I reread your second post.

[Welshgasman]

Try taking your Dims out of the loop.
Why not do the sort in the recordset?

[Bill the Cat]

Try taking your Dims out of the loop.
Why not do the sort in the recordset?

I'm getting random selections from the recordset as a QA for the employee's notes. The record number needs to be sorted into proper sequence. The strange thing is that even with all of the code for the data that fills the spreadsheets gone, and just the headers there, it still fails on the second pass.

[Welshgasman]

I have seen this behaviour before. It is when am object is not fully referenced.
For some reason it does not happen on first run.

You could upload the DB with enough to see the issue with instructions on how to recreate?

[Micron]

I can't see anything obvious but for sure the problem lies on the Excel side. I'd try putting a break point on rst.close then go to task manager and make sure Excel is not still listed as an open application OR as a background process.

Seems obvious that you're not using Option Explicit because your rs variable is not declared. I also would not be recreating all of those objects in each iteration.

[madpiet]

It doesn't look like you're closing and destroying the second recordset object. You're using it to loop, but you clean up. your could should be something like

...
Loop

rs.Close
Set rs = Nothing

so the recordset is basically left open... that might explain why you're having a problem. you should make sure you close anything you open and then destroy references to them by setting them to nothing. And do it in your error handling too in case your code crashes. Then it can clean up after itself.

[June7]

Qualify references to Columns and Range.

oExcelWrSht.Columns("A:G").Sort key1:=oExcelWrSht.Range("G:G")

Avoid using ActiveANYTHING. You declare and set worksheet object variable, use it.

Open/Quit Excel app once outside loop. Open and save workbooks within loop.

Use Option Explicit in all module headers to force variable declaration https://www.accessforums.net/showthread.php?t=69816

Upload db or show sample data as table in post. Use the table builder on Advanced post edit toolbar. Can even copy/paste from Access or Excel.

Code appears to create a workbook and format columns but not seeing where data is actually transferred. Are you familiar with CopyFromRecordset method?

I've never used Execute to open ADODB recordset. Why not use DAO?

Private Sub Btn_Assessor_Samples_Click()
Dim xAssessor As Variant
Dim rst As DAO.Recordset, rs As DAO.Recordset
Dim db As DAO.Database
Dim oExcel          As Object
Dim oExcelWrkBk     As Object
Dim oExcelWrSht     As Object

Set oExcel = CreateObject("Excel.Application")
oExcel.ScreenUpdating = True
oExcel.Visible = True

Set db = CurrentDb
Set rs = db.OpenRecordset("Qry_NormalAssignments")
rs.MoveFirst
Do While Not rs.EOF
    xAssessor = rs.Fields(0).Value
    MsgBox xAssessor, vbOKOnly
    'Get Recordset
    Set rst = db.OpenRecordset("SELECT * FROM Qry_ObjectiveValidationSample" & _
                            " WHERE ASSESSOR =" & Chr(34) & xAssessor & Chr(34) & _
                            " ORDER BY Sorting")
    If Not rst.EOF Then
        Set oExcelWrkBk = oExcel.Workbooks.Add()
        Set oExcelWrSht = oExcelWrkBk.Sheets(1)
        oExcelWrSht.Cells(1, 1).Value = "Family"
        oExcelWrSht.Cells(1, 2).Value = "Requirement Number"
        oExcelWrSht.Cells(1, 3).Value = "Requirement"
        oExcelWrSht.Cells(1, 4).Value = "Objective Number"
        oExcelWrSht.Cells(1, 5).Value = "Objective Text"
        oExcelWrSht.Cells(1, 6).Value = "Objective Validation"
        
        oExcelWrSht.Range("A2").CopyFromRecordset rst
        
        With oExcelWrSht.Range("1:1")
            .EntireRow.Font.Bold = True
            .WrapText = True
        End With
        With oExcelWrSht.Range("A:A")
            .EntireColumn.ColumnWidth = 8
        End With
        With oExcelWrSht.Range("B:B")
            .EntireColumn.ColumnWidth = 12
            .WrapText = True
        End With
        With oExcelWrSht.Range("C:C")
            .EntireColumn.ColumnWidth = 30
            .WrapText = True
        End With
        With oExcelWrSht.Range("D:D")
            .EntireColumn.ColumnWidth = 9
            .WrapText = True
        End With
        With oExcelWrSht.Range("E:E")
            .EntireColumn.ColumnWidth = 30
            .WrapText = True
        End With
        With oExcelWrSht.Range("F:F")
            .EntireColumn.ColumnWidth = 70
            .WrapText = True
        End With

        oExcelWrkBk.SaveAs ("C:\temp\Excel_" & xAssessor & ".xlsx")
        MsgBox "data exported", vbOKOnly
    
        rst.Close
        Set rst = Nothing
        Set oExcelWrSht = Nothing
        Set oExcelWrkBk = Nothing
    End If
    rs.MoveNext
Loop
oExcel.Quit
Set oExcel = Nothing
End Sub