Why my code is executing faster if I click left mouse button? - excel

Question

I have some procedure where it takes different amount of time to execute. If I do nothing it takes 5 times longer to execute. When I click left mouse button during execution of same procedure, it finishes after few seconds. Can anyone explain why that happens and how to prevent it from happening in future?
I have tried to set arrays in code to nothing.
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
I would expect same code to run same amount of time.