Change event code generates Run-Time error '28' out of stack space

Question

This code worked in Excel 2010, however I now have Excel 2013.

The error is

Run-Time error '28' out of stack space, Run-Time error '2147417848 (80010108)': Method 'Value' of object 'Range' Failed

Code is as follows.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, r As Range, rv As Long

If Not Intersect(Target, Range("C77:AD81")) Is Nothing Then
    Set rng = Intersect(Target, Range("C77:AD81"))
    For Each r In rng

        'Peak Flow Doctor Warning

        Select Case r.Value
            Case 180
                MsgBox "''PEAK FLOW CRITICAL AT 180L/MIN''" & vbCrLf & "''PREDNISONE PROBABLY REQUIRED''" & vbCrLf & "''MAKE DOCTOR'S APPOINTMENTS ASAP''", vbInformation, "WARNING"
            Case 120
                MsgBox "''PEAK FLOW CRITICAL AT 120L/MIN''" & vbCrLf & "''MAKE URGENT DOCTOR'S APPOINTMENTS''" & vbCrLf & "''OR GO TO A&E IMMEDIATELY''", vbInformation, "CRITICAL WARNING"
            Case Is >= 525
                MsgBox "''CHECK OR TEST PEAK FLOW METER''" & vbCrLf & "''IT MAY BE FAULTY AND GIVING FALSE HIGH's''", vbInformation, "WARNING"
        End Select
    Next r
End If
   'OraKinetics needs to change to (Target, Range("C95:AD95"))
If Not Intersect(Target, Range("C93:AD93")) Is Nothing Then
    Set rng = Intersect(Target, Range("C93:AD93"))
    For Each r In rng

        'Weight Gain Warning

        Select Case r.Value
            Case 90
                MsgBox "''LIKELY TO EXACERBATE COPD SYMPTOMS''" & vbCrLf & "''CHRONIC ASTHMA OR EMPHYSEMA PROBABLE''", vbCritical, "WARNING"
            Case 95
                MsgBox "''IF SWELLING IN ANKLES PROBABLE FLUID RETENTION''" & vbCrLf & "''POSSIBILITY OF HEART FAILURE IF UNATTENDED''", vbCritical, "CRITICAL WARNING"
        End Select
    Next r
End If

'Change Best Peak Flow and Date Achieved

ActiveSheet.Unprotect Password:="asthma"
If Range("R7").Value > Range("F7").Value Then
    Range("R7").Select
    Selection.Copy
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K7") = Date
    Application.CutCopyMode = False
    ActiveSheet.Protect Password:="asthma", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End Sub

Take a look at this link and this one. Most probably your VBA is modifying a cell which triggers the calculation of other cells, which then trigger the VBA again, forming a closed loop. This behave may fill your stack space. Try to identify this, or alternatively enclose parts of your VBA code with Application.EnableEvents = False / Application.EnableEvents = True until you find the issue in your sheet. — sɐunıɔןɐqɐp
Possible duplicate of Runtime error '28': Out of stack space in Excel VBA — sɐunıɔןɐqɐp
sɐunıɔןɐqɐp using your code enclosure suggestion I found the problem which is the "If Not Intersect(Target, Range("C77:AD81")) Is Nothing Then" code. but if I remove it the MsgBox's do not activate, and I'm not sure how to correct the b problem. — Father Goose

SierraOscar SierraOscar · Accepted Answer · 2018-11-16T11:02:05

If you're creating changes inside a _Change event then you need to disable events before the change to prevent an infinite loop.

Application.EnableEvents = False

ActiveSheet.Unprotect Password:="asthma"
If Range("R7").Value > Range("F7").Value Then
    Range("R7").Select
    Selection.Copy
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K7") = Date
    Application.CutCopyMode = False
    ActiveSheet.Protect Password:="asthma", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If

Application.EnableEvents = True

Change event code generates Run-Time error '28' out of stack space

1 Answers