Slet af linie (entirerow) med change event kørende

Hej,
Jeg har en udfordring i at min excel ark fryser, når jeg prøver at slette en hel linie fra arket.
Har på fornemmelsen, at der kører en change event loop, som får det til at fryse.

Er der mulighed for at indsætte et "exit sub" hvis en hel række slettes?


Her er koden, hvis det hjælper...

Dim vOurResult

Private Sub Worksheet_change(ByVal Target As Range)

    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    If Target.Cells.Count > 1 Then
       
        Exit Sub
    End If

    If Not Intersect(Target, Range("g2:g50")) Is Nothing Then

        If Target.Cells.Count > 1 Then
            Exit Sub
        End If
       
        If WorksheetFunction.CountIf([opslag], Target.Value) > 0 Then
            With [opslag]
                vOurResult = .Find(What:=Target.Value, After:=.Cells(1, 1), _
                    LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
            End With
        End If
   
        SetValidation Target.Row, Target.Column + 1
       
    End If

    If Not Intersect(Target, Range("A2:A50")) Is Nothing Then

        If Target.Cells.Count > 1 Then
            Exit Sub
        End If
       
        SetCaseNo Target.Row, Target.Column + 1

    End If

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
   
End Sub


Private Sub SetValidation(ByVal lRow As Long, ByVal iCol As Integer)
     
    Cells(lRow, iCol).Clear
     
    With Cells(lRow, iCol).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & vOurResult
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
   
End Sub

Private Sub SetCaseNo(ByVal lRow As Long, ByVal iCol As Integer)
     
    If Len(Cells(lRow, iCol).Value) > 1 Then
    Else
        Cells(lRow, iCol).Value = [case_no].Value
        [case_no].Value = [case_no].Value + 1
    End If
   
End Sub