VBA - событие BeforeSave не работает

Question

Я пытаюсь показать несколько сообщений об ошибках перед сохранением рабочего листа, но при попытке сохранить документ процедура не вызывается.Кто-нибудь может найти где проблема? Вот мой код:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Application.EnableEvents = False
Dim cell As Range
Dim j As String
     Dim i As Integer
     Dim cellVal As Integer
     Dim cellVal2 As Integer
     Dim sCellVal As String
     Dim a As Variant
     Dim Target As Range
     Dim arr As Range
     Dim rngcheck As Range


 sCellVal = Range("A2").Value
 cellVal = Range("B3").Value
 cellVal2 = Range("B4").Value

   If Not IsNumeric(cellVal) Then
   MsgBox "Only numeric values allowed."
   End If

    If Not sCellVal = "ID" Then
            Cancel = True
            MsgBox "The Parameter “ID” must be defined"
    End If

    If sCellVal = "" Then
        Cancel = True
        MsgBox "Missing ID for the blockTemplate"
    End If

    If sCellVal = "IDs" Then
        'Cancel = True
        MsgBox "Cell A2 contains an invalid value: “Ids”"
    End If

    If Not cellVal = (6 < 72) Then
        MsgBox "Font Size must be an integer from 6 till 72"
    End If

    If Not cellVal2 = (6 < 72) Then
        MsgBox "Paragraph Spacing Before must be an integer from 6 till 72"
    End If

   Set arr = Range("C6:C7")
    'If the columns is the eighth
    For Each a In arr
            ActiveSheet.Range("C6:C7").Select
    If Target.Column = 2 And (Target.Row > 5 And Target.Row < 8) Then


    If IsEmpty(cell) Then

            MsgBox (" The cell" + Target.Address(0, 0)) + "is not allowed to be empty. To define null for this value use the minus sign (-)."

   'The Cell C6 is not allowed to be empty. To define null for this value use the minus sign (-).

    End If
    End If

  'Next a:
   MsgBox (" The Variant IDs QINTRO_VAR1, QINTRO_VAR2 are not compatible with the global ID QUINTRO")



  Set rngcheck = Range("B2:B4")

  i = 0

  For Each cell In rngcheck


    If IsEmpty(cell) Then

          i = i + 1

          j = j & cell.Address & vbNewLine

        End If

        Next cell

         If i = 0 Then Exit Sub

              MsgBox "Sorry, you must enter a value in: " & vbNewLine & j

 Application.EnableEvents = True

 End Sub