Solved

Getting Error Application Defined - or Object defined error

Posted on 2014-09-11
5
607 Views
Last Modified: 2014-09-12
I have the following code and I'm getting the error "Application Defined - or Object defined" on line 24:  lRow = .Cells(.Rows.Count, "B").End(xlUp).Row.   This worked fine until I upgraded to Access 2010 and Windows 7.

            
Dim lRow As Long
            'Process if Begin or End Dates are not null
            If Me.txtBeginDT <> "" Or Me.txtEndDT <> "" Then
            'Go back to top of Spreadsheet and Save to Report Name
                With xlObj.Worksheets(1)
                    .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
                    With .Range("A1:A2").Font
                        .Bold = True
                        .ThemeColor = 2
                        .TintAndShade = -0.249977111117893
                    End With
                                        
                    xlObj.Cells.Select
                    .Cells.WrapText = False
                    .Cells.EntireColumn.AutoFit
                    .Cells.Rows.AutoFit
                    
                    With xlObj
                        .Worksheets(1).Select
                        .Range("A5").Select
                                                                
                        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                        .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
                        .Range("B" & lRow + 1).Font.Bold = True
                        .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
                        .Range("A" & lRow + 1).Font.Bold = True
                        .Range("A" & lRow + 1).HorizontalAlignment = xlRight
                        .Range("A" & lRow + 1).VerticalAlignment = xlBottom
                        .Range("A" & lRow + 1).Font.Color = -16776961
                    End With
                    
                End With

Open in new window

0
Comment
Question by:gdunn59
  • 3
  • 2
5 Comments
 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
ID: 40317779
Try substituting the Excel VBA constant xlUp with it's value, -4162, or add this at the top of the code.
Const xlUp = -4162

Open in new window


You might also want to change the code to this so that the first With is used throughout the code.
Const xlUp = -4162

' rest of code

Dim lRow As Long
'Process if Begin or End Dates are not null
If Me.txtBeginDT <> "" Or Me.txtEndDT <> "" Then
    'Go back to top of Spreadsheet and Save to Report Name
    With xlObj.Worksheets(1)
        .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
        .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
        With .Range("A1:A2").Font
            .Bold = True
            .ThemeColor = 2
            .TintAndShade = -0.249977111117893
        End With

        .Cells.WrapText = False
        .Cells.EntireColumn.AutoFit
        .Cells.Rows.AutoFit


        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
        .Range("B" & lRow + 1).Font.Bold = True
        .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
        .Range("A" & lRow + 1).Font.Bold = True
        .Range("A" & lRow + 1).HorizontalAlignment = xlRight
        .Range("A" & lRow + 1).VerticalAlignment = xlBottom
        .Range("A" & lRow + 1).Font.Color = -16776961
    End With

Open in new window

0
 
LVL 1

Author Comment

by:gdunn59
ID: 40317836
imnorie:

I used your suggestion and it finally got past that point, but now I get the error on line 28 of the code "Unable to set the HorizontalAlignment Property of the Range Class".

I'm sure I need to do the same with this as far as adding the Const xlRight =, but I don't know what it should be.

Is there a list somewhere where I could get this information?

Thanks,
gdunn59
0
 
LVL 1

Author Comment

by:gdunn59
ID: 40317883
imnorie:

I added the following Const and they all worked:

Const xlRight = -4152
Const xlBottom = -4107
Const xlUp = -4162
Const xlEdgeBottom = 9
Const xlContinuous = 1
Const xlThin = 2
Const xlThemeColorAccent1 = 5
Const xlCancel = 1
0
 
LVL 33

Expert Comment

by:Norie
ID: 40317974
Sorry, didn't notice xlRight in the code.

Anyway you can find all the constants in the Object Browser(F2) in Excel VBA,  or in Access VBA if you have added a reference for the appropriate library.

Oops, looks like you might have found that yourself.:)
0
 
LVL 1

Author Comment

by:gdunn59
ID: 40320295
Imnorie:

Everything is working now.

Here is my final code:

Private Sub cmdDetErrRpt_Click()
On Error GoTo Err_cmdDetErrRpt_Click
Dim stDocNameMgr As String
Dim stDocNameEmp As String
Dim stDocNameDept As String
Dim stDocNameAuditor As String
Dim stDocNameRegion As String
Dim strOutputToPath As String
Dim rtn As String
Dim xlObj As Object
Dim xlWb As Object
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim qdf As QueryDef
Dim qdf2 As QueryDef
Dim BegDate As String
Dim EndDate As String
Dim Template As String
Dim Hrs As String
Dim sMinDte As Variant
Dim sMaxDte As Variant
Dim stDocName As String
Dim stDocName2 As String
Dim stDocNameErrorDetailsALL As String
Dim stDocNameErrorDetailsFINAL As String
Dim stDocNameErrors As String

DoCmd.Echo False
DoCmd.SetWarnings False

DoCmd.Hourglass True

''C Drive Path
'strOutputToPathCDrive = "c:\QA Database\Employee Audit Scorecard System\Reports\ErrorDetailReport_By" & "" & Me!cboReportCateg & "_" & Me!cboCategSelect & "_" & Format(Now(), "mm-dd-yyyy") & ".xlsx"
'
''Template on C Drive
'TemplatefileC = "C:\Documents and Settings\ab56446\Application Data\Microsoft\Templates\Audit_DB_ErrorDetail_TEMPLATE.xltx"
'
''Remove Report if process is run more than once daily on C Drive
'If Dir(strOutputToPathCDrive) <> "" Then Kill strOutputToPathCDrive

'Network Path
strOutputToPath = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\Reports\ErrorDetailReport_By" & "" & Me!cboReportCateg & "_" & Me!cboCategSelect & "_" & Format(Now(), "mm-dd-yyyy") & ".xlsx"

'Template on Network
Templatefile = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\TEMPLATE\Audit_DB_ErrorDetail_TEMPLATE.xltx"

'Remove Report if process is run more than once daily
If Dir(strOutputToPath) <> "" Then Kill strOutputToPath


stDocNameMgr = "qryErrorDetailByMgr (for Report)"
stDocNameEmp = "qryErrorDetailByEmp (for Report)"
stDocNameDept = "qryErrorDetailByDept (for Report)"
stDocNameAuditor = "qryErrorDetailByAuditor (for Report)"
stDocNameRegion = "qryErrorDetailByRegion (for Report)"
stDocNameErrorDetailsALL = "qryErrorDetailAssocReport"
stDocNameErrorDetailsFINAL = "qryErrorDetailAssocReport (FINAL)"
stDocNameErrors = "qryErrorScores"

DoCmd.OpenQuery stDocNameErrorDetailsALL
DoCmd.OpenQuery stDocNameErrorDetailsFINAL
DoCmd.OpenQuery stDocNameErrors

If IsNull(Me.cboReportCateg) Or IsNull(Me.cboCategSelect) Then
    MsgBox "Please make selections from the drop-downs for a Auditor, Department, Employee or Manager", vbOKOnly
    Me.cboReportCateg.SetFocus
    Me.cboReportCateg.Dropdown
ElseIf (Me.cboReportCateg) = "Manager" Then
    DoCmd.OpenQuery stDocNameMgr
ElseIf (Me.cboReportCateg) = "Employee" Then
    DoCmd.OpenQuery stDocNameEmp
ElseIf (Me.cboReportCateg) = "Department" Then
    DoCmd.OpenQuery stDocNameDept
ElseIf (Me.cboReportCateg) = "Auditor" Then
    DoCmd.OpenQuery stDocNameAuditor
ElseIf (Me.cboReportCateg) = "Region" Then
    DoCmd.OpenQuery stDocNameRegion
End If

Set xlObj = CreateObject("excel.application")

If IsNull(Me.cboReportCateg) Or IsNull(Me.cboCategSelect) Then
    MsgBox "Please make selections from the drop-downs for a Auditor, Department, Employee or Manager", vbOKOnly
    Me.cboReportCateg.SetFocus
    Me.cboReportCateg.Dropdown
End If

' check to see if Table "tblErrorDetails (for Report)" contains data
If DCount("*", "tblErrorDetails (for Report)") > 0 Then
    xlObj.Workbooks.Add Templatefile
'    xlObj.Workbooks.Add TemplatefileC
        With xlObj
            .Worksheets(1).Select
            .Range("A5").Select
            Set qdf = CurrentDb.QueryDefs("qryErrorDetails_Summary")
            Set rs = qdf.OpenRecordset
            .selection.CopyFromRecordset rs
            rs.Close
                
            .Worksheets(2).Select
            .Range("A5").Select
            Set qdf2 = CurrentDb.QueryDefs("qryErrorDetails")
            Set rs2 = qdf2.OpenRecordset
            .selection.CopyFromRecordset rs2
            rs2.Close

        End With
        
 Const xlUp = -4162
 Const xlRight = -4152
 Const xlBottom = -4107
 Const xlEdgeBottom = 9
 Const xlThin = 2

           Dim lRow As Long
            'Process if Begin or End Dates are not null
            If Me.txtBeginDT <> "" Or Me.txtEndDT <> "" Then
            'Go back to top of Spreadsheet and Save to Report Name
                With xlObj.Worksheets(1)
                    .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
                    With .Range("A1:A2").Font
                        .Bold = True
                        .ThemeColor = 5
                        .TintAndShade = -0.249977111117893
                    End With
                                        
'                    xlObj.Cells.Select
                    .Cells.WrapText = False
                    .Cells.EntireColumn.Autofit
                    .Cells.Rows.Autofit
                                                            
                    With xlObj
                        .Worksheets(1).Select
                        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                        .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
                        .Range("B" & lRow + 1).Font.Bold = True
                        .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
                        .Range("A" & lRow + 1).Font.Bold = True
                        .Range("A" & lRow + 1).HorizontalAlignment = xlRight
                        .Range("A" & lRow + 1).VerticalAlignment = xlBottom
                        .Range("A" & lRow + 1).Font.Color = -16776961
                    End With
                    
                End With
                
                With xlObj.Worksheets(1).Range("B" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                
                With xlObj.Worksheets(1)
                    lRow = .Cells(.Rows.Count, "C").End(xlUp).Row
                    .Range("C" & lRow + 1).Formula = "=Sum(C5:C" & lRow & ")"
                    .Range("C" & lRow + 1).Font.Bold = True
                End With
                
                With xlObj.Worksheets(1).Range("C" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                
                With xlObj.Worksheets(1)
                    lRow = .Cells(.Rows.Count, "D").End(xlUp).Row
                    .Range("D" & lRow + 1).Formula = "=Sum(D5:D" & lRow & ")"
                    .Range("D" & lRow + 1).Font.Bold = True
                End With
                
                With xlObj.Worksheets(1).Range("D" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
    
                With xlObj.Worksheets(2)
                    .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
                    With .Range("A1:A2").Font
                        .Bold = True
                        .ThemeColor = 5
                        .TintAndShade = -0.249977111117893
                    End With
                    
                    .Cells.WrapText = False
                    .Cells.EntireColumn.Autofit
                    .Cells.Rows.Autofit
                    
                    xlObj.Range("A5").Select

                End With
            
                xlObj.ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
'                xlObj.ActiveWorkbook.SaveAs strOutputToPathCDrive, CreateBackup:=False
                                
                DoCmd.Hourglass False
                DoCmd.Echo False
                xlObj.Visible = True
                xlObj.Worksheets(1).Select
                xlObj.Range("A5").Select
                DoCmd.Echo True
        
            Else
                With xlObj.Worksheets(1)
                    .Range("A1").Value = "For Dates:  " & DMin("[Quality_Review_Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Quality_Review_Date]", "tblErrorDetails (for Report)")
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
                    With .Range("A1:A2").Font
                        .Bold = True
                        .ThemeColor = 5
                        .TintAndShade = -0.249977111117893
                    End With
                    
                    lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                    .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
                    .Range("B" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
                    .Range("A" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).HorizontalAlignment = xlRight
                    .Range("A" & lRow + 1).VerticalAlignment = xlBottom
                    .Range("A" & lRow + 1).Font.Color = -16776961
                End With
                
                With xlObj.Worksheets(1).Range("B" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                    
                With xlObj.Worksheets(1)
                    lRow = .Cells(.Rows.Count, "C").End(xlUp).Row
                    .Range("C" & lRow + 1).Formula = "=Sum(C5:C" & lRow & ")"
                    .Range("C" & lRow + 1).Font.Bold = True
                End With
                
                With xlObj.Worksheets(1).Range("C" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                
                With xlObj.Worksheets(1)
                    lRow = .Cells(.Rows.Count, "D").End(xlUp).Row
                    .Range("D" & lRow + 1).Formula = "=Sum(D5:D" & lRow & ")"
                    .Range("D" & lRow + 1).Font.Bold = True
                End With
                
                With xlObj.Worksheets(1).Range("D" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
    
                With xlObj.Worksheets(2)
                    .Range("A1").Value = "For Dates:  " & DMin("[Quality_Review_Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Quality_Review_Date]", "tblErrorDetails (for Report)")
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
                    .Cells.Select
                    .Cells.EntireColumn.Autofit
                    
                    With .Range("A1:A2").Font
                        .Bold = True
                        .ThemeColor = 5
                        .TintAndShade = -0.249977111117893
                    End With
                    
                    xlObj.Range("A5").Select

                End With
                                
                xlObj.ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
'                xlObj.ActiveWorkbook.SaveAs strOutputToPathCDrive, CreateBackup:=False

                DoCmd.Hourglass False
                DoCmd.Echo False
                xlObj.Visible = True
                xlObj.Worksheets(1).Select
                xlObj.Range("A5").Select
                DoCmd.Echo True
            End If
    
Else
    'if table "tblErrorDetails (for Report)" contains no data
    MsgBox "There are no results for the selected criteria. Please revise your criteria, and try again.", vbOKOnly
    Me.cboCategSelect.SetFocus
End If

DoCmd.SetWarnings True
DoCmd.Echo True
DoCmd.Hourglass False

Exit_Err_cmdDetErrRpt_Click:
    
    Exit Sub

Err_cmdDetErrRpt_Click:
If Err.Number = 2501 Then
    'no action required - ignore the error - because opening of report was cancelled
Else
    MsgBox Err.Description
End If

GoTo Exit_Err_cmdDetErrRpt_Click

Me.cboCategSelect = Null
Me.cboReportCateg = Null
Me.txtBeginDT = Null
Me.txtEndDT = Null
Me.cboDept = Null

End Sub

Open in new window

0

Featured Post

Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
unable to save new report from old one 9 29
How can you open the FORM2 2 31
Trying to open FORM in specific record !! 6 45
VBA name newly created sheet 4 24
We were having a lot of "Heartbeat Alerts" in our SCOM environment, now "Heartbeat" in a SCOM environment for those of you who might not be familiar with SCOM is a packet of data sent from the agent to the management server on a regular basis, basic…
User Beware!  This is a rather permanent solution to removing your email from an exchange server.  The only way to truly go back is to have your exchange administrator restore your mailbox from backups.  This is usually the option of last resort.  A…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…

773 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question