Excel VBA Worksheet change crashes

Question

I tried running a worksheet change macro and it seems that when I had an error (due to data validation from a list) in one of the cells and then clicked somewhere else in the sheet, then the excel crashes.

This sheet has worksheet change macros and I assume that due to this, it keeps on crashing. Can someone help? Thanks.

   
Option Explicit
Dim Monitored



'Private Sub Worksheet_Activate()
    'Monitored = Sheet1.Range("C110").Value 'Read in value prior to any changes
'End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Dim KeyCells As Range
Dim KeyCells2 As Range
'Regelmäßigkeit
Set KeyCells = Sheet1.Range("A1:M157")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

If Sheet1.Range("L38").Value = "Nein" Then
    Sheet1.Rows("42:44").Hidden = True
   
ElseIf Sheet1.Range("L38").Value = "Ja" Then
    Sheet1.Rows("42:44").Hidden = False
    
End If

'Keine extra Frage
If Sheet1.Range("C99").Value = "17. Bitte beachten Sie folgende Besonderheiten:" Then
    Sheet1.Rows("98:103").Hidden = True
'Extra Frage
ElseIf Sheet1.Range("C99").Value <> "17. Bitte beachten Sie folgende Besonderheiten:" Then
    Sheet1.Rows("98:103").Hidden = False

End If

Dim lastRow As Long
Dim sumX As Long
Dim result As String
Dim sumXY As Long


'Keine Extra Frage
If Sheet1.Rows("98:103").Hidden = True Then

'Unvollständig
If Application.WorksheetFunction.CountIf(Sheet1.Range("P1:P97"), "X") > 0 Then
    Sheet1.Range("C106").Value = Sheet2.Range("A53").Value
ElseIf Application.WorksheetFunction.CountIf(Sheet1.Range("P1:P97"), "X") = 0 Then

        'Check if the value in E25 is in Sheet2 column G
        If Application.WorksheetFunction.CountIf(Sheet2.Range("H3:H229"), Sheet1.Range("E25").Value) > 0 Then
            'If the value is found, sum the values in O1:O98
            sumX = Application.WorksheetFunction.CountIf(Sheet1.Range("O1:O97"), "X")


            If sumX = 16 Then
                'Wenn Summe gleich 16 ist, dann genehmigt
                Sheet1.Range("C106").Value = Sheet2.Range("A33").Value
            ElseIf sumX < 16 Then
                'Wenn Summe ungleich 16 ist, dann mit Vorbehalt
                Sheet1.Range("C106").Value = Sheet2.Range("A43").Value
            End If
        Else
                Sheet1.Range("C106").Value = Sheet2.Range("A43").Value
        End If
End If

'Extra Frage
ElseIf Sheet1.Rows("98:103").Hidden = False Then

'Unvollständig
If Application.WorksheetFunction.CountIf(Sheet1.Range("P1:P99"), "X") > 0 Then
    Sheet1.Range("C106").Value = Sheet2.Range("A53").Value

ElseIf Application.WorksheetFunction.CountIf(Sheet1.Range("P1:P99"), "X") = 0 Then

        'Check if the value in E25 is in Sheet2 column G
        If Application.WorksheetFunction.CountIf(Sheet2.Range("H3:H229"), Sheet1.Range("E25").Value) > 0 Then
            'If the value is found, sum the values in O1:O98
            sumX = Application.WorksheetFunction.CountIf(Sheet1.Range("O1:O99"), "X")
    
            If sumX = 17 Then
                'Wenn Summe gleich 17 ist, dann genehmigt
                Sheet1.Range("C106").Value = Sheet2.Range("A33").Value
            ElseIf sumX < 17 Then
                'Wenn Summe ungleich 17 ist, dann mit Vorbehalt
                Sheet1.Range("C106").Value = Sheet2.Range("A43").Value
            End If
        Else
                Sheet1.Range("C106").Value = Sheet2.Range("A43").Value

        End If
End If
End If


'Colour coding
If Sheet1.Range("C106").Value = Sheet2.Range("A33").Value Then
Sheet1.Range("C106").Interior.ColorIndex = 43
ElseIf Sheet1.Range("C106").Value = Sheet2.Range("A43").Value Then
Sheet1.Range("C106").Interior.ColorIndex = 44
ElseIf Sheet1.Range("C106").Value = Sheet2.Range("A53").Value Then
Sheet1.Range("C106").Interior.ColorIndex = 46
End If

End If

End Sub

I guess by crashing you mean that you get run time error 28 _Nicht genügend Stapelspeicher_ = **Out of Stack space**, right? — Storax, May 13 '23 at 07:03
When working with `Worksheet_Change`, I recommend seeing [THIS](https://stackoverflow.com/questions/13860894/why-ms-excel-crashes-and-closes-during-worksheet-change-sub-procedure/13861640#13861640) post... — Siddharth Rout, May 13 '23 at 12:22

Storax · Answer 1 · 2023-05-13T07:21:11.917

In case you get an Out of Stack space error when using a worksheet event you have to turn off the event handler i.e. you add Application.EnableEvents = False at the beginning. And, of course, you should turn it on again at the end youf your code.

If you do not turn off the event handler, the worksheet_change event will be called again and again because you change values in the worksheet. And this will happen as along as stack space is available

I usually code it like that

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo EH
    Application.EnableEvents = False

    ' code which should run
EH:
    ' just to make sure that Events get triggered again
    ' even in case there is an error in the previous code
    Application.EnableEvents = True
    
End Sub

Excel VBA Worksheet change crashes

1 Answers1