Range(ActiveCell.offset fails second time run

[Rx_]

Failure at line 510 - the commented line just before it works fine!
So does the commented line below BUT only the first time, trying to run a second time generates an object variable error.
The intMaxHeaderColCount is Good.
While I can hard code the offset value (rather than keep it dynamic for a different record set) and it never fails on the 2nd, 3rd, 4th... time

Is there any other way to dynamically select the range based on the number of columns returned from a recordset?

" 91 Object variable in block not set"

260     If ObjXL Is Nothing Then            ' just in case Excel was already running in memory
270       Set ObjXL = New excel.Application
280       ObjXL.EnableEvents = False
290     Else
300       excel.Application.Quit
310       Set ObjXL = New excel.Application
320       objExcel.EnableEvents = False
330     End If
340       Set rsData = frm.RecordsetClone
350     ObjXL.Workbooks.Add
360       intWorksheetNum = 1                                   ' Refer to sheet by its number in code
370       ObjXL.Visible = True                                  ' *********** Excel visible True for testing *******
 
380       intRowPos = 6                                       ' Row data starts in Excel (keep everything relative from here)
                                                  ' Always start at 2 or higher - the title will appear in the row above this
                                                      ' *******   Recordset Count ****************
390       rsData.MoveLast                                         ' force to last for accruate record count
400         intMaxRecordCount = rsData.RecordCount              ' how many records
410       rsData.MoveFirst                                        ' reset pointer for poste
420       ObjXL.Workbooks(1).Worksheets(1).Range("A" & intRowPos).Select                     ' adjusts to Row data starts
430       ObjXL.Application.DisplayAlerts = False                 ' Turn off Are You Shure? questions - turn back on at end
 
440         intMaxheaderColCount = rsData.Fields.count - 1
450     For intHeaderColCount = 0 To intMaxheaderColCount
460     If Left(rsData.Fields(intMaxheaderColCount).Name, 3) <> "xxx" Then  ' Future use - adding xxx title in queries for fields to exclude
470           ObjXL.Worksheets(intWorksheetNum).Cells(intRowPos - 1, intHeaderColCount + 1) = rsData.Fields(intHeaderColCount).Name    ' Relative to intRowPos
480     End If
490       Next intHeaderColCount
          'Debug.Print "Columns created count is " & intHeaderColCount
500       ObjXL.Workbooks(1).Worksheets(1).Rows((intRowPos - 1) & ":" & (intRowPos - 1)).Select         ' Selection for Bold header column (can make 2 Rows if needed)
        'ObjXL.Range("A" & intRowPos - 1).Select        ' Select the first column at our starting Row for the header
        'ObjXL.Range("A" & intRowPos - 1 & ":AE" & intRowPos - 1).Select  ' Put Title at one row less than where data starts
            ' ****************************** this next line will error the Second Time Through even if all forms are closed back to switchboard ******
510     ObjXL.Workbooks(1).Worksheets(1).Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, intMaxheaderColCount)).Select
        'ObjXL.Range(ActiveCell.Offset(0, intMaxheaderColCount)).Select
        '   in debug window   ? objxl.Activecell does return correct value in the active cell
520     Call Send2ExcelRowHeaderFormat(ObjXL)               ' Format the data row heading  bold, outline, as a Select
 
530      With ObjXL.Workbooks(1).Worksheets(1)                                             ' Complete the data row heading Format as Rows & Cells
540        .Rows((intRowPos - 1) & ":" & (intRowPos - 1)).RowHeight = 25.5
550        .Rows((intRowPos - 1) & ":" & (intRowPos - 1)).Select                                    ' Selection for Bold header column (can make 2 if needed)
560        .Cells.EntireColumn.AutoFit
570      End With

 

[Rx_]

ObjXL.Range(ActiveCell, ActiveCell.Offset(0, intMaxheaderColCount)).Select
Since the ActiveCell show up correctly in the debugger window...
This code above was shown on an web site- exactly the same issue
It failed on the second pass through
And, the intmaxheadercolcount variable is holding the correct (same) value the second time through.
I dim ObjXL as both Object and Excell.Application, no difference in the result.

 

[boblarson]

This error usually means that somewhere in your code (and you don't show the full code) an Excel object was referred to without being tied to the application object. If that happens then it will open another instance of Excel to handle it. That will be a hidden instance which you won't see (unless you open your task manager and see the extra Excel.exe listed). It won't close until you close Access. So, once you do that then you can run your code again and it will work fine.

So the trick is to find the offending part of the code. If you don't spot it, post all of the code and we'll see if we can spot it for you. I'll take a look with what you have listed and see if there is anything I spot.

 

[Rx_]

I really do appreciate your offer!
I will post this code, because it is your web page's code that I am adding a lot of custome features to.
Although after chasing this error down for 3 hours, my code has gotten really ugly with all the modifications.

However... I got a cup of coffee and thought of something that worked.
I had been watching my task window, and there was not Excel running afterwards.
It was on the line of code, looking at me all day like that stupid GEIGO commercial with the bundle of cash and the eyes.

This fixed it!
510 ObjXL.Workbooks(1).Worksheets(1).Range(ObjXL.ActiveCell.Offset(0, 0), ObjXL.ActiveCell.Offset(0, intMaxheaderColCount)).Select

I suggest that this is posted up on a different thread so others can find it when they are looking for it. It is difficult to search for anywhere on the internet.

 

[boblarson]

Yep, the Activecell without the reference to the app object would cause a problem.

Oh, and I do have a web page that talks about this (see here).

 

[Rx_]

That is an excellent article on Early and Late Binding. At first I was using early binding and then switched just to see if there was a difference. Then I went back and put the verbose path just to try and slay this dragon. Lesson, just concentrate on the line of code that is known to cause the problem.

This code came from your web site. This is an attempt to create a more universal function for several of my Access forms to create a somewhat standard template, and to pass in a parameter that will allow some custom formatting. Using Citrix, it saves the Excel output in a networked drive. It should look much better as I will keep coming back to it between other tasking.

note: the subroutine is above the Function

Private Sub Send2ExcelRowHeaderFormat(ObjXLHeader As Object)
10    With ObjXLHeader                                    ' ************************  Excel Data Row Header Formatting ***************
20            With .Selection.Font
30                .Bold = True
40                .Name = "Arial"
50                .Size = 12
60                .ThemeColor = xlThemeColorLight1
70            End With
               
80            With .Selection.Borders(xlEdgeTop)
90                .LineStyle = xlContinuous
100                 .ColorIndex = 0
110                 .TintAndShade = 0
120               .Weight = xlMedium
130           End With
              
140           With .Selection.Borders(xlEdgeLeft)
150               .LineStyle = xlContinuous
160               .ColorIndex = xlAutomatic
170               .TintAndShade = 0
180               .Weight = xlMedium
190           End With
200           With .Selection.Borders(xlEdgeBottom)
210               .LineStyle = xlContinuous
220               .ThemeColor = 10
230               .TintAndShade = -0.499984740745262
240               .Weight = xlMedium
250           End With
260           With .Selection.Borders(xlEdgeRight)
270               .LineStyle = xlContinuous
280               .ColorIndex = 0
290               .TintAndShade = 0
300               .ColorIndex = xlAutomatic
310               .Weight = xlMedium
320           End With
330           With .Selection.Borders(xlInsideVertical)
340               .LineStyle = xlContinuous
350               .ColorIndex = 0
360               .TintAndShade = 0
370               .ColorIndex = xlAutomatic
380               .Weight = xlMedium
390           End With
                                                                             ' for test mode - this is called later after data is entered
400     End With
End Sub
 

Public Function Send2Excel(frm As Form, Optional strSheetName As String, Optional ReportName As String, Optional FormatInstruction As String) As Boolean
      ' Example: Users like the filter and sort function of ROW sfROWSearch and want to send it to Excel
      ' frm is the name of the form you want to send to Excel
      ' strSheetName is the name of the sheet you want to name it to
      ' Calling code example:
      'Dim FormName As Form
      'Dim Success as boolean
      'Set FormName = Me.sfROWList.Form
      'Success = Send2Excel(FormName, "ROW List")
      ' *****************************************************  Form to Excel Report *****************
          Dim rsData                   As dao.Recordset
          Dim ObjXL                    As Object
          Dim xlWBk                   As excel.Workbook
          Dim xlWSh                   As excel.Application
          Dim fld                     As Field
          Dim UserLogin               As String
          Dim UserPath                As String
          Dim intMaxRecordCount       As Integer
          Dim intMaxColCount          As Integer
          Dim sngTimer                As String
          Dim sngTotalTime            As Single
          Dim strNewReportPath        As String  ' for directory to save
          Dim intWorksheetNum         As Integer
          Dim intRowNumber            As Integer
          Dim intColumnNumber         As Integer
          Dim intRowPos               As Integer
          Dim MyPlage                 As excel.Range
          Dim rngRange                As excel.Range
          Dim c                       As excel.Range
          Dim StartTimer              As Long
          Dim StopTimer               As Long
          Dim TotalTime               As Long
      Const xlCenter As Long = -4108
      Const xlBottom As Long = -4107
10        On Error GoTo err_handler
20    Send2Excel = False              ' Failure is default until function completes without errors
                              ' Establish user name and folder path to save Excel
30    If Len(ReportName) < 2 Then
40        ReportName = "UnknownReport"
50    End If
60    UserLogin = Environ("username")
70    UserPath = "X:\Drilling\Regulatory\Regulatory Database Reports\" & UserLogin & "\" & ReportName
80    strNewReportPath = UserPath
90    DirName = strNewReportPath
100       If Dir(DirName, vbDirectory) = "" Then
110             If MsgBox("Is it OK to create a new folder in My Documents? (recommended yes)", vbOKCancel) = vbOK Then
120               DirName = UserPath
130                 MkDir DirName
140                 Err.Clear
150         Else
160             MsgBox "Create new folder cancelled. Folder not created.", vbOKOnly, "Report Cancelled, must allow folder to be created"
170                 Exit Function         ' if user does not allow new folder, exit now
180         End If
190       Else
              'MsgBox "The folder already exists..." & Chr(10) & "Please check the directories using Windows Explorer.", vbOKOnly
200       End If      '
210     If Err.Number <> 0 Then
220         MsgBox "Network path or user rights needs to be resolved " & Err.Description, vbOKOnly, "Network path to My Documents not found"
230         Err.Raise 3582, "ExcelReports", "Code module"
240     End If
                                            
250     StartTimer = Timer
260     If ObjXL Is Nothing Then            ' just in case Excel was already running in memory
270       Set ObjXL = New excel.Application
280       ObjXL.EnableEvents = False
290     Else
300       ObjXL.Application.Quit
310       Set ObjXL = New excel.Application
320       ObjXL.EnableEvents = False
330     End If
340       Set rsData = frm.RecordsetClone
350     ObjXL.Workbooks.Add
360       intWorksheetNum = 1                                   ' Refer to sheet by its number in code
370       ObjXL.Visible = True                                  ' *********** Excel visible True for testing *******
          
380       intRowPos = 6                                       ' Row data starts in Excel (keep everything relative from here)
                                                  ' Always start at 2 or higher - the title will appear in the row above this
                                                      ' *******   Recordset Count ****************
390       rsData.MoveLast                                         ' force to last for accruate record count
400         intMaxRecordCount = rsData.RecordCount              ' how many records
410       rsData.MoveFirst                                        ' reset pointer for poste
420       ObjXL.Workbooks(1).Worksheets(1).Range("A" & intRowPos).Select                     ' adjusts to Row data starts
430       ObjXL.Application.DisplayAlerts = False                 ' Turn off Are You Shure? questions - turn back on at end
          
440         intMaxheaderColCount = rsData.Fields.count - 1
450     For intHeaderColCount = 0 To intMaxheaderColCount
460     If Left(rsData.Fields(intMaxheaderColCount).Name, 3) <> "xxx" Then  ' Future use - adding xxx title in queries for fields to exclude
470           ObjXL.Worksheets(intWorksheetNum).Cells(intRowPos - 1, intHeaderColCount + 1) = rsData.Fields(intHeaderColCount).Name    ' Relative to intRowPos
480     End If
490       Next intHeaderColCount
          'Debug.Print "Columns created count is " & intHeaderColCount
500       ObjXL.Workbooks(1).Worksheets(1).Rows((intRowPos - 1) & ":" & (intRowPos - 1)).Select         ' Selection for Bold header column (can make 2 Rows if needed)
        'ObjXL.Range("A" & intRowPos - 1).Select        ' Select the first column at our starting Row for the header
505        'ObjXL.Workbooks(1).Worksheets(1).Range("A" & intRowPos - 1 & ":H" & intRowPos - 1).Select  ' Put Title at one row less than where data starts
            ' The line 505 works every time! *********************
            ' ****************************** this next line will error the Second Time Through even if all forms are closed back to switchboard ******
510     ObjXL.Workbooks(1).Worksheets(1).Range(ObjXL.ActiveCell.Offset(0, 0), ObjXL.ActiveCell.Offset(0, intMaxheaderColCount)).Select
511        'ObjXL.Range(ActiveCell, ActiveCell.Offset(0, intMaxheaderColCount)).Select
        '   in debug window   ? objxl.Activecell does return correct value in the active cell
520     Call Send2ExcelRowHeaderFormat(ObjXL)               ' Format the data row heading  bold, outline, as a Select
                                  
530      With ObjXL.Workbooks(1).Worksheets(1)                                             ' Complete the data row heading Format as Rows & Cells
540        .Rows((intRowPos - 1) & ":" & (intRowPos - 1)).RowHeight = 25.5
550        .Rows((intRowPos - 1) & ":" & (intRowPos - 1)).Select                                    ' Selection for Bold header column (can make 2 if needed)
560        .Cells.EntireColumn.AutoFit
570      End With
                              ' ************************  Paste Recordset Data into Excel Data Area ***************
580       ObjXL.Workbooks(1).Worksheets(1).Range("A" & intRowPos).CopyFromRecordset rsData
590       ObjXL.Workbooks(1).Worksheets(1).Range("1:1").Select
600       ObjXL.ActiveSheet.Cells.Select        ' selects all of the cells
610       ObjXL.ActiveSheet.Cells.EntireColumn.AutoFit  ' does the "autofit" for all columns
        
620       If formatinstructions = "ROW_Report_A" Then    ' Custom instructions for each report
630           ObjXL.Workbooks(1).Worksheets(1).Columns("A:A").Select
640           ObjXL.Workbooks(1).Worksheets(1).Selection.Delete Shift:=xlToLeft
          
650       ObjXL.Workbooks(1).Worksheets(1).Rows((intRowPos - 1) & ":" & (intRowPos - 1)).Select              ' based on relative position for where data starts above
660       ObjXL.Workbooks(1).Worksheets(1).Selection.AutoFilter
        
670     ObjXL.Workbooks(1).Worksheets(1).Rows((intRowPos) & ":" & (intRowPos)).Select                            ' first Data row to freeze payne
680     ObjXL.Workbooks(1).Worksheets(1).ActiveWindow.FreezePanes = True
        ' **************** auto fit again - filter cuts off last letters
690     ObjXL.Workbooks(1).Worksheets(1).Cells.EntireColumn.AutoFit                                  ' did this to show arrows in filter, it messup footages
          
700       End If
710   StopTimer = Timer
720   TotalTime = StopTimer - StartTimer
730   ObjXL.Workbooks(1).Worksheets(1).Range("A1").Select
740   ObjXL.ActiveCell.FormulaR1C1 = "Code Completed in " & CStr(Format(TotalTime, "0.00")) & " seconds"
          
750   ObjXL.Application.Calculation = xlAutomatic
760   ObjXL.ActiveWorkbook.PrecisionAsDisplayed = False
                                                                      ' Future for security addition
770   If CurrentUser <> "Admin" And CurrentUser <> "SomeUSERNAME" And blnTestMode = False Then
780       ObjXL.ActiveWorkbook.SaveAs FileName:=strNewReportPath
790   End If
800     strSaveAsFileName = strNewReportPath & "\" & Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & "-" & Hour(Now()) & "-" & Minute(Now()) & "-" & " ROW Report.xlsx"
810   ObjXL.ActiveWorkbook.SaveAs FileName:=strSaveAsFileName
820   ObjXL.Workbooks(1).Close                      'keeps failing second run through see if this fixes it
830   ObjXL.Application.Quit
      'Set xlWBk = Nothing  ' no longer used
840   Set ObjXL = Nothing                                       ' destroy variable
      'ObjXL.Application.Quit
      'Set ObjXL = Nothing                                       ' destroy variable
850   msgString = strNewReportPath & Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & "-" & Hour(Now()) & "-" & Minute(Now()) & "-" & ReportName & ".xlsx"
860   MsgBox "Excel report saved at : " & msgString, vbOKOnly, "Please Open This File Location for Your Report"
          'ObjXL.Application.DisplayAlerts = True                      ' turned off earlier
870       rsData.Close
880       Set rsData = Nothing
890       Send2Excel = True
900   Exit Function
err_handler:
910       DoCmd.SetWarnings True
920       MsgBox Err.Description, vbExclamation, Err.Number
            ObjXL.Workbooks(1).Close
930       ObjXL.Application.Quit
940       'Set xlWBk = Nothing  no longer used
950       Set ObjXL = Nothing                                       ' destroy variable
960       rsData.Close
970       Set rsData = Nothing
980       Exit Function
End Function