Переменная определяет значение для ячейки, но вызывает пользовательскую функцию и выполняется после

Question

Назначение кода

Мой лист представляет собой обзор соглашений. Первый лист представляет собой обзор, и каждое соглашение имеет лист для себя. Вот почему я не перебираю первый лист. Всякий раз, когда он обнаруживает, что дата окончания соглашения предшествует дате сегодняшнего дня, он обновляет год окончания даты в соответствии с автоматическим продлением соглашения.

Задача

У меня есть проблема, когда на моем листе требуется обновить строку даты, но всякий раз, когда это происходит, он каким-то образом вызывает мою пользовательскую функцию, которая не имеет к этому никакого отношения. После вызова пользовательской функции она выполняется и обновила значение. Всякий раз, когда это входит в мою функцию, которая является:

    Function NxtShtNm(number As Long) As String
    Application.Volatile True
    NxtShtNm = ActiveWorkbook.Sheets(ActiveSheet.Index + number - 1).Name
    End Function

это разрушает формулу в моей камере. Эта формула использовалась для гиперссылки на различные листы из обзорного листа.

Значение

LnLVal - 10-11-2018
NtceVal составляет 8 месяцев
AutoExtVal составляет 5 лет

Sub Message()
Dim sht As Worksheet
Dim c As Range
Dim Wf As WorksheetFunction
Dim LastRow As Long
Dim OblLeftLR As String, NtceLR As String
Set sht = Sheets(1)
Set Wf = WorksheetFunction
Dim vR() As Variant
Dim k As Long, j As Integer

OblLeft = sht.Range("1:1").Find("Obligation left").Address(False, False, xlA1)
OblLeftSub = sht.Range(OblLeft).Application.WorksheetFunction.Substitute(OblLeft, "1", "")
OblLeftOff = sht.Range(OblLeft).Offset(1, 0).Address(False, False, xlA1)
OblLR = sht.Cells(sht.Rows.Count, OblLeftSub).End(xlUp).Row
rngOblLeft = OblLeftOff & ":" & OblLeftSub & OblLR
rngOblMinus = WorksheetFunction.CountIf(Range(rngOblLeft), "")
rngObl = OblLeftOff & ":" & OblLeftSub & OblLR - rngOblMinus

Ntce = sht.Range("1:1").Find("Notice").Address(False, False, xlA1)
NtceSub = sht.Range(Ntce).Application.WorksheetFunction.Substitute(Ntce, "1", "")
NtceOff = sht.Range(Ntce).Offset(1, 0).Address(False, False, xlA1)
NtceLR = sht.Cells(sht.Rows.Count, NtceSub).End(xlUp).Row
rngNtce2 = NtceOff & ":" & NtceSub & NtceLR
rngNtceMinus = WorksheetFunction.CountIf(Range(rngNtce2), "")
rngNtce = NtceOff & ":" & NtceSub & NtceLR - rngNtceMinus

StreNme = sht.Range("1:1").Find("Store").Address(False, False, xlA1)
StreNmeSub = sht.Range(StreNme).Application.WorksheetFunction.Substitute(StreNme, "1", "")
StreNmeOff = sht.Range(StreNme).Offset(1, 0).Address(False, False, xlA1)
StreNmeVal2 = ""

AutoExt = sht.Range("1:1").Find("Automatical extension of contract").Address(False, False, xlA1)
AutoExtSub = sht.Range(AutoExt).Application.WorksheetFunction.Substitute(AutoExt, "1", "")

LnL = sht.Range("1:1").Find("Lease end lessee").Address(False, False, xlA1)
LnLSub = sht.Range(LnL).Application.WorksheetFunction.Substitute(LnL, "1", "")

MyDate = Date

On Error Resume Next

For Each c In Range(rngObl).Cells
    If Not IsEmpty(c) Then
        CValue = c.Value
        CAddress = c.Address(False, False, xlA1)
        NtceAddress = sht.Range(CAddress).Application.WorksheetFunction.Substitute(CAddress, OblLeftSub, NtceSub)
        NtceValue = sht.Range(NtceAddress).Value
        NtceVal = Left(NtceValue, WorksheetFunction.Find(" ", NtceValue) - 1)
        CVal = Left(CValue, WorksheetFunction.Find(" ", CValue) - 1)
        Rslt = CVal - NtceVal
            If Rslt <= 3 Then
                StreNmeAddress = sht.Range(CAddress).Application.WorksheetFunction.Substitute(CAddress, OblLeftSub, StreNmeSub)
                StreNmeVal = sht.Range(StreNmeAddress).Value
                AutoExtAddress = sht.Range(CAddress).Application.WorksheetFunction.Substitute(CAddress, OblLeftSub, AutoExtSub)
                AutoExtVal = sht.Range(AutoExtAddress).Value
                RsltMsg = Rslt & " month(s) - "
                    If Rslt = 0 Then
                        LnLAddress = sht.Range(CAddress).Application.WorksheetFunction.Substitute(CAddress, OblLeftSub, LnLSub)
                        LnLVal = sht.Range(LnLAddress).Value
                        Rslt = DateDiff("d", MyDate, LnLVal) - 365
                        RsltMsg = Rslt & " days - "
                            If Rslt = 1 Then
                                RsltMsg = Rslt & " day - "
                            End If
                    End If
                    If Rslt = 1 Then
                        RsltMsg = Rslt & " month - "
                    End If
                Msg = StreNmeVal2 & vbNewLine & StreNmeVal & " will renew in " & RsltMsg & AutoExtVal
            End If
        StreNmeVal2 = Msg
    End If
Next

On Error GoTo 0

MsgBox "The rent agreements for the following stores will automatically renew its period, within the next 3 months:" & vbNewLine & Msg

End Sub

Sub UpdateSheets()
Dim WS_count As Integer
Dim I As Integer
Dim sht As Worksheet

Today = Date

WS_count = ActiveWorkbook.Worksheets.Count

For I = 1 To WS_count
    If I = 1 Then
        Else
        Set sht = Sheets(I)
            LnLAddress = sht.Range("A:A").Find("Lease end lessee:", , LookIn:=xlValues).Address(False, False, xlA1)
            LnLOff = sht.Range(LnLAddress).Offset(0, 1).Address(False, False, xlA1)
            LnLVal = sht.Range(LnLOff).Value
            NtceAddress = sht.Range("A:A").Find("Notice:", , LookIn:=xlValues).Address(False, False, xlA1)
            NtceOff = sht.Range(NtceAddress).Offset(0, 1).Address(False, False, xlA1)
            NtceVal = sht.Range(NtceOff).Value
            On Error GoTo Ending:
            NtceVal = Left(NtceVal, Application.WorksheetFunction.Find(" ", NtceVal) - 1)
            LnLVal = DateSerial(Year(LnLVal), Month(LnLVal) - NtceVal, Day(LnLVal))
            LnLYear = Year(LnLVal)
            On Error GoTo 0
                If LnLYear <= Year(Today) Then
                    LnLMonth = Month(LnLVal)
                        If LnLMonth <= Month(Today) Then
                            LnLDay = Day(LnLVal)
                                If LnL < Day(Today) Then
                                AutoExtAddress = sht.Range("A:A").Find("Automatical extension of contract", , LookIn:=xlValues).Address(False, False, xlA1)
                                AutoExtOff = sht.Range(AutoExtAddress).Offset(0, 1).Address(False, False, xlA1)
                                AutoExtVal = sht.Range(AutoExtOff).Value
                                AutoExt = Left(AutoExtVal, Application.WorksheetFunction.Find(" ", AutoExtVal) - 1)
                                LnLNewVal = DateSerial(Year(LnLVal) + AutoExt, Month(LnLVal) + NtceVal, Day(LnLVal))
                                Application.Calculation = xlCalculationManual
                                sht.Range(LnLOff).Value = LnLNewVal
                                Application.Calculation = xlCalculationAutomatic
                                End If
                        End If
                End If
    End If
Ending:
On Error GoTo 0
Next I

End Sub

Цель

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

Application.Calculation = xlCalculationManual
Application.Calculation = xlCalculationAutomatic

Но это не помогло, оно просто задержало переход в модуль до xlCalculationAutomatic.

Заранее спасибо за помощь:)