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

Question

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

Я пытался установить массивы в коде на ноль.

Sub Main()
    Dim NumberOfCompanies As Long
    Dim LastRow As Long
    Dim StartTime As Double
    Dim MinutesElapsed As String
    StartTime = Timer
    '////////////////////////////
    Sheets("Process").Activate
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ...
    Call Result
    ...
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Sheets("Result").Activate
    '\\\\\\\\\\\\\\\\\\\\\\\\\\\
    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
    LastRow = CountRow("Result", 1)
    NumberOfCompanies = Sheets("Result").Cells(LastRow, "A").Value
    MsgBox "There are " & NumberOfCompanies & " candidates for Nace change!" & " This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
End Sub


Sub Result()
    Dim CompanyNumbersArray As Variant
    Dim StartingRow As Variant
    Dim EndingRow As Variant
    Dim LastRow As Long
    Dim ArraySize As Long
    Dim Count As Long
    Dim i As Long
    Dim j As Long
    Dim CompanyRows As Long
    Dim k As Long
    Dim Background As Boolean
    Dim CurrentCompany As String
    Dim NextCompany As String
    Dim Str As String
    Sheets("Process").Activate
    Sheets("Result").Range("A2:XFD1048576").Clear
    Sheets("NoResult").Range("A2:XFD1048576").Clear
    LastRow = CountRow("Process", 1)
    CompanyNumbersArray = Sheets("Process").Range("A2:A" & LastRow)
    StartingRow = Sheets("Process").Range("O2:O" & LastRow).Value
    EndingRow = Sheets("Process").Range("P2:P" & LastRow).Value
    Sheets("Process").Range("A2:S" & LastRow).Copy Destination:=Sheets("Result").Range("A2:S" & LastRow)
    Sheets("Process").Range("A2:S" & LastRow).Copy Destination:=Sheets("NoResult").Range("A2:S" & LastRow)
    Sheets("Result").Range("A:T").Borders(xlInsideHorizontal).LineStyle = xlLineStyleNone
    Sheets("NoResult").Range("A:T").Borders(xlInsideHorizontal).LineStyle = xlLineStyleNone
    ArraySize = UBound(CompanyNumbersArray)
    Count = 1
    For i = 1 To ArraySize - 1
        CurrentCompany = CompanyNumbersArray(i, 1)
        NextCompany = CompanyNumbersArray(i + 1, 1)
        If CurrentCompany <> NextCompany Then
            Count = Count + 1
        End If
    Next
    Str = "Result: Copying data to sheets /Result/ and /NoResult/ "
    Call ProgressOfCode(1, 4, Str)
    i = 1
    For j = 1 To Count
        Background = True
        CompanyRows = EndingRow(i, 1) - StartingRow(i, 1) + 1
        For k = 0 To CompanyRows - 1
            If (Sheets("Process").Range("R" & i + 1 + k).Interior.ColorIndex = xlNone) Then
                Background = False
            Else
                Background = True
                Exit For
            End If
        Next
        If Background = False Then
            Sheets("Result").Range("A" & StartingRow(i, 1) & ":T" & EndingRow(i, 1)).Value = vbNullString
            Sheets("Result").Range("A" & StartingRow(i, 1) & ":T" & EndingRow(i, 1)).Interior.Color = xlNone
        ElseIf Background = True Then
            Sheets("NoResult").Range("A" & StartingRow(i, 1) & ":T" & EndingRow(i, 1)).Value = vbNullString
            Sheets("NoResult").Range("A" & StartingRow(i, 1) & ":T" & EndingRow(i, 1)).Interior.Color = xlNone
        End If
        If EndingRow(i, 1) < LastRow Then
            i = EndingRow(i, 1)
        End If
    Next
    Str = "Result: Copying data to sheets /Result/ and /NoResult/ "
    Call ProgressOfCode(2, 4, Str)
    Sheets("Result").Activate
    Sheets("Result").Range("A:T").Sort Key1:=Range("N2"), key2:=Range("A2"), Order1:=xlAscending, Order2:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    Sheets("NoResult").Activate
    Sheets("NoResult").Activate
    Sheets("NoResult").Range("A:T").Sort Key1:=Range("N2"), key2:=Range("A2"), Order1:=xlAscending, Order2:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    Call ResultRestoreLines("Result")
    Str = "Result: Copying data to sheets /Result/ and /NoResult/ "
    Call ProgressOfCode(3, 4, Str)
    Call ResultRestoreLines("NoResult")
    Str = "Result: Copying data to sheets /Result/ and /NoResult/ "
    Call ProgressOfCode(4, 4, Str)
    Application.StatusBar = "Done!"
    Application.Wait (Now + TimeValue("00:00:01"))
    Application.StatusBar = False
End Sub

Private Sub ResultRestoreLines(SheetName As String)
    Dim CompanyNumbersArray As Variant
    Dim CompanyStructureArray As Variant
    Dim LastRow As Long
    Dim ArraySize As Long
    Dim Count As Long
    Dim i As Long
    Dim CurrentRow As Long
    Dim CurrentCompany As String
    Dim NextCompany As String
    LastRow = CountRow(SheetName, 1)
    CompanyNumbersArray = Sheets(SheetName).Range("A2:A" & LastRow).Value
    CompanyStructureArray = Sheets(SheetName).Range("N2:N" & LastRow).Value
    ArraySize = UBound(CompanyNumbersArray)
    Count = 1
    For i = 1 To ArraySize - 1
        CurrentCompany = CompanyNumbersArray(i, 1)
        NextCompany = CompanyNumbersArray(i + 1, 1)
        If CurrentCompany <> NextCompany Then
            Count = Count + 1
        End If
    Next
    CurrentRow = 2
    For i = 1 To Count
        Sheets(SheetName).Range("A" & CurrentRow & ":P" & CurrentRow + CompanyStructureArray(CurrentRow - 1, 1) - 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
        CurrentRow = CurrentRow + CompanyStructureArray(CurrentRow - 1, 1)
    Next
    LastRow = CountRow(SheetName, 1)
    Sheets(SheetName).Cells(LastRow + 2, "A").Value = Count
End Sub

Я ожидаю, что один и тот же код будет выполняться столько же времени.