代码执行已中断

Question

In Excel VBA, I am running into an "error" that halts the macro and a message displays "Code execution has been interrupted." I wrote error in quotations because when I selected debug and examined the line of code that prompted the error, I saw that it was logically sound.

I originally ran into the error at On Error GoTo 0 . When I comment out a block around the error, then I get a new line that produces the same error. And, again, when I examine it in debug mode the new "error" is logically sound. Here is the exact line:

If rRange.Row <> 3 And rRange.Row <> 17 Then

FYI, rRange.Row = 3 in this case, so it shouldn't produce an error.

Why is this happening and how can I fix it?

UPDATE Code now produces the error on the End Sub line.

Here is the section that fails:

Sub Review()

Dim WorkRange As Range
Dim FoundCells As Range
Dim Cell As Range
Dim a As String
Dim policy As String
Dim rRange As Range


Set RR = Sheets("Ready for Review")
Set OG = ActiveSheet

OG.Unprotect ("Password")

RR.Activate

On Error Resume Next

Application.DisplayAlerts = False

    Set rRange = Application.InputBox(Prompt:= _
        "Please select POLICY to review.", _
            Title:="SPECIFY POLICY", Type:=8)

On Error GoTo 0
    Application.DisplayAlerts = True
        If rRange.Row <> 3 And rRange.Row <> 17 Then

            MsgBox "Value other than a POLICY was selected. Select the cell that contains the correct policy number."

        Exit Sub

        Else
            policy = rRange.Value
        End If

Application.ScreenUpdating = False

OG.Cells(12, 2).Locked = False

Set WorkRange = OG.UsedRange
For Each Cell In WorkRange
    If Cell.Locked = False Then
        col1 = Cell.Column
        Row = Cell.Row
        a = OG.Cells(Row, 1)

        If Not a = "" Then
            row2 = Application.WorksheetFunction.Match(a, RR.Range("A:A"), 0)

            Cell.Value = RR.Cells(row2, rRange.Column + col1 - 2)
        End If

    End If
Next Cell

OG.Unprotect ("Password")

OG.Cells(33, 3).Locked = False

If (Right(OG.Cells(5, 2), 2) = "UL" Or Right(OG.Cells(5, 2), 2) = "IL" Or Right(OG.Cells(5, 2), 2) = "PL") Then
    With OG.Cells(33, 3)
        .Value = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""Total*"",A:A,0)))-SUM(C34:C37)"
        .Locked = True
    End With

    ElseIf Right(OG.Cells(5, 2), 2) = "WL" Then
    With OG.Cells(33, 3)
        .Value = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""*"",A:A,0))) - IFERROR(INDEX(C34:C37,MATCH(""Additional"",B34:B37, 0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Paid"",B34:B37,0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Additional Agreement - SPPUA"",B34:B37, 0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Flexible Agreement - FLXT10/20"",B34:B37, 0)),0)"
        .Locked = True
    End With

    Else
    With OG.Cells(33, 3)
        .Value = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""*"",A:A,0)))"
        .Locked = True
End With

End If

OG.Activate


Cells(Application.WorksheetFunction.Match("Last Month Paid ($)", Range("A:A"), 0), 2).NumberFormat = "$#,##0.00;[Red]$#,##0.00"

OG.Protect ("Password")

Application.ScreenUpdating = True

End Sub

Answer 1

Oh, that brings back memories for me. I think I used to get this error about 10 years ago Excel 2003? Maybe?. Excel would get itself into a bit of a state. Nothing was wrong with the code, just it would keep coming back with that error.

If you save your work close Excel and then reopen, does the error go away? If I remember right, it was caused when I called some external API. Maybe some other API call in your is causing this error but manifesting at this point... perhaps.

Sorry but it was 10+ years ago :)

Answer 2

even if you went through it, you may want to consider the following "restyling" of the code you posted

Option Explicit

Sub Review()

Dim Cell As Range, rRange As Range
Dim a As String
Dim RR As Worksheet, OG As Worksheet

    Set RR = Sheets("Ready for Review")
    Set OG = ActiveSheet

    OG.Unprotect ("Password")

    Set rRange = GetUserInpt(RR)
    If rRange Is Nothing Then
        MsgBox "You aborted the POLICY selection" _
                & vbCrLf & vbCrLf _
                & "the procedure ends" _
                , vbInformation
        Exit Sub
    End If


    Application.ScreenUpdating = False

    OG.Cells(12, 2).Locked = False

    For Each Cell In OG.UsedRange
        With Cell
            If Not .Locked Then
                a = OG.Cells(.row, 1)
                If Not a = "" Then .value = RR.Cells(CLng(Application.WorksheetFunction.Match(a, RR.Range("A:A"), 0)), _
                                                     rRange.Column + .Column - 2)
            End If
        End With
    Next Cell


    With OG.Cells(33, 3)
       .Locked = False
        Select Case Right(OG.Cells(5, 2), 2)
            Case "UL", "IL", "PL"
                .Formula = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""Total*"",A:A,0)))-SUM(C34:C37)"            
            Case "WL"
                .Formula = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""*"",A:A,0))) - IFERROR(INDEX(C34:C37,MATCH(""Additional"",B34:B37, 0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Paid"",B34:B37,0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Additional Agreement - SPPUA"",B34:B37, 0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Flexible Agreement - FLXT10/20"",B34:B37, 0)),0)"            
            Case Else
                .value = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""*"",A:A,0)))"
        End Select
        .Locked = True
    End With

    OG.Activate

    Cells(Application.WorksheetFunction.Match("Last Month Paid ($)", Range("A:A"), 0), 2).NumberFormat = "$#,##0.00;[Red]$#,##0.00"

    OG.Protect ("Password")

    Application.ScreenUpdating = True

End Sub


Function GetUserInpt(sht As Worksheet) As Range
Dim rRange As Range

    Application.DisplayAlerts = False
    sht.Activate
    On Error GoTo InputBoxCanceled
    Do While rRange Is Nothing
        Set rRange = Application.InputBox(Prompt:="Please select POLICY to review.", _
                                          Title:="SPECIFY POLICY", _
                                          Default:=sht.Cells(3, 1).Address, _
                                          Type:=8)

        If rRange.Parent.Name <> sht.Name Then
            MsgBox "You must select a cell in '" & sht.Name & "' sheet"
            sht.Activate
            Set rRange = Nothing
        Else
            If rRange.row <> 3 And rRange.row <> 17 Then
                MsgBox "Value other than a POLICY was selected" _
                       & vbCrLf & vbCrLf _
                       & "Select the cell that contains the correct policy number" _
                       , vbCritical
                Set rRange = Nothing
            End If
        End If
    Loop
    Set GetUserInpt = rRange

InputBoxCanceled:
    On Error GoTo 0
    Application.DisplayAlerts = True

End Function

the main revision applies to:

• added a GetUserInpt function to handle the policy selection

  this function:

  • checks for both the correct selection row and sheet, too (since it's possible the user shifts to another worksheet during selection!)

  • runs a loop until the user selects a proper cell

  • exits selection upon user canceling the InputBox , as the only loop escape possibility

• made some simplifications here and there, like:

  • eliminated Activate statements unless really needed

  • reduced the amount of variables to only (nearly) strictly needed ones

  • added some With ... End With blocks to add readability

  • used a Select Case block instead of an If ... Then ... Else if ... Else ... End if one, for readability again

  • changed .Value to .Formula , for a proper syntax

all what above could help you with this project and in future ones, too