The Ubiquitous: Application defined or object defined error

Question

I wrote a little macro that enters transactions into our ERP system and things seem to get gummed up when it's determining whether or not the second location defined in the spreadsheet is greater than zero. Here is my code:

    Option Explicit

Sub DblChk()

If (MsgBox("Are you sure you are ready to append scrap data to QAD? This cannot be reversed.", vbOKCancel)) = 1 Then

Call Scrap

Else: Exit Sub

End If

End Sub

Sub Scrap()

On Error GoTo ErrorHelper

Sheets("Roundup").Select

Range("I2").Select

Call Shell("C:\Program Files\QAD\QAD Enterprise Applications 2.9.6\QAD.Applications.exe", vbNormalFocus)

'Sign in to QAD
Application.Wait (Now + TimeValue("0:00:05"))
SendKeys ("username")
SendKeys ("{TAB}")
SendKeys ("password")
SendKeys ("{ENTER}")

'Enter Scrap

Application.Wait (Now + TimeValue("0:00:15"))
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))

'Scrap Loop

Do While Not IsEmpty(ActiveCell)

If ActiveCell.Value > 0 Then

ActiveCell.Offset(0, -8).Activate
SendKeys (ActiveCell.Value)
ActiveCell.Offset(0, 6).Activate
SendKeys ("{ENTER}")
SendKeys (ActiveCell.Value)
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
ActiveCell.Offset(0, -1).Activate
SendKeys (ActiveCell.Value)
SendKeys ("{ENTER}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys ("SCRAP")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
ActiveCell.Offset(0, 2).Activate
SendKeys (ActiveCell.Value)
SendKeys ("{TAB}")
ActiveCell.Offset(0, -4).Activate
SendKeys (ActiveCell.Value)
SendKeys ("{TAB}")
ActiveCell.Offset(0, 1).Activate
SendKeys (ActiveCell.Value)
SendKeys ("{ENTER}")
SendKeys ("{ENTER}")
ActiveCell.Offset(1, -4).Activate

Else

ActiveCell.Offset(1, 0).Activate

End If

Loop
ErrorHelper:
MsgBox Err.Description
End Sub

I've seen several references to this error on the internet but none that seem to apply to my specific situation. It seems to be going awry at the beginning of the If statement.

Any thoughts?

Answer 1

I have done some adjustments to your code (see comments within code)

Sub DblChk()
    Rem This line is enough anything else is redundant
    If MsgBox("Are you sure you are ready to append scrap data to QAD? This cannot be reversed.", vbOKCancel) = 1 Then Call Scrap
End Sub

This is your code revised, note use of declared variables, it still shows original lines "commented"

General assumption is that the Offset commands always refer to the ActiveCell in this line:

Do While Not IsEmpty(ActiveCell) replace by this Do While rCll.Value2 <> Empty

Note the addition of the Exit Sub line before the ErrorHelper line otherwise it will always show the error message even if there is no error.

Sub Scrap()
Dim rCll As Range
On Error GoTo ErrorHelper

''    Sheets("Roundup").Select
''    Range("I2").Select
    Set rCll = ThisWorkbook.Sheets("Roundup").Range("I2") 'If Procedure resides is Workbook with data
    'Set rCll = Workbooks(WbkName).Sheets("Roundup").Range("I2") 'If Procedure does not reside is Workbook with data

    Call Shell("C:\Program Files\QAD\QAD Enterprise Applications 2.9.6\QAD.Applications.exe", vbNormalFocus)

    'Sign in to QAD
    Application.Wait (Now + TimeValue("0:00:05"))
        SendKeys ("username")
        SendKeys ("{TAB}")
        SendKeys ("password")
        SendKeys ("{ENTER}")

    'Enter Scrap
    Application.Wait (Now + TimeValue("0:00:15"))
        SendKeys ("{TAB}")
    Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys ("{TAB}")
    Application.Wait (Now + TimeValue("0:00:01"))

    'Scrap Loop
'    Do While Not IsEmpty(ActiveCell)
    Do While rCll.Value2 <> Empty
    Rem ActiveCell.Value2=empty is more accurate than IsEmpty(ActiveCell)
        With rCll

            If .Value2 > 0 Then

'                ActiveCell.Offset(0, -8).Activate
'                    SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, -8).Value2)

'                ActiveCell.Offset(0, 6).Activate
                SendKeys ("{ENTER}")
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, 6).Value2)
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
'                ActiveCell.Offset(0, -1).Activate
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, -1).Value2)
                SendKeys ("{ENTER}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
                SendKeys ("SCRAP")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
'                ActiveCell.Offset(0, 2).Activate
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, 2).Value2)
                SendKeys ("{TAB}")

'                ActiveCell.Offset(0, -4).Activate
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, -4).Value2)
                SendKeys ("{TAB}")

'                ActiveCell.Offset(0, 1).Activate
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, 1).Value2)
                SendKeys ("{ENTER}")
                SendKeys ("{ENTER}")

'                ActiveCell.Offset(1, -4).Activate
                Set rCll = .Offset(1, -4)

            Else
'                ActiveCell.Offset(1, 0).Activate
                rCll = .Offset(1, 0)

        End If: End With

    Loop

Exit Sub
ErrorHelper:
    MsgBox Err.Description

End Sub

However you can avoid the use of the Do...Loop by identifying and declaring your target range earlier

Sub Scrap_Using_Range()
Dim rTrg As Range
Dim rCll As Range
On Error GoTo ErrorHelper


    Set rCll = ThisWorkbook.Sheets("Roundup").Range("I2") 'If Procedure resides is Workbook with data
    'Set rCll = Workbooks(WbkName).Sheets("Roundup").Range("I2") 'If Procedure does not reside is Workbook with data

    With rCll
        Set rTrg = IIf(.Offset(1, 0).Value2 = Empty, .Cells, Range(.Cells, .Cells.End(xlDown)))
    End With

    Call Shell("C:\Program Files\QAD\QAD Enterprise Applications 2.9.6\QAD.Applications.exe", vbNormalFocus)

    'Sign in to QAD
    Application.Wait (Now + TimeValue("0:00:05"))
        SendKeys ("username")
        SendKeys ("{TAB}")
        SendKeys ("password")
        SendKeys ("{ENTER}")

    'Enter Scrap
    Application.Wait (Now + TimeValue("0:00:15"))
        SendKeys ("{TAB}")
    Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys ("{TAB}")
    Application.Wait (Now + TimeValue("0:00:01"))

    'Scrap Loop
    For Each rCll In rTrg
        With rCll
            If .Value2 > 0 Then
                SendKeys (.Offset(0, -8).Value2)

                SendKeys ("{ENTER}")
                SendKeys (.Offset(0, 6).Value2)
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
                SendKeys (.Offset(0, -1).Value2)
                SendKeys ("{ENTER}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
                SendKeys ("SCRAP")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
                SendKeys (.Offset(0, 2).Value2)
                SendKeys ("{TAB}")

                SendKeys (.Offset(0, -4).Value2)
                SendKeys ("{TAB}")

                SendKeys (.Offset(0, 1).Value2)
                SendKeys ("{ENTER}")
                SendKeys ("{ENTER}")

    End If: End With: Next

Exit Sub
ErrorHelper:
    MsgBox Err.Description

End Sub