Option Base 1
Option Explicit
Option Private Module
'====================================================================================================
Sub Test()
Dim t!, r&, n&

n = 1000000
Columns(1).ClearContents
Application.EnableCancelKey = xlErrorHandler
On Error GoTo er

t = Timer
    For r = 1 To n
        If Not PRDX_StatusBar(r, n, , True) Then MsgBox "Cancel Process", vbCritical, "Cancel": GoTo fin
        If Err Then GoTo fin
        Cells(r, 1).Value2 = 1
    Next r
MsgBox "Done", vbInformation, Format$(Timer - t, "#,##0 sec"): GoTo fin

er: MsgBox "«Esc»-button cancel processing!", vbCritical, "TEST"
Columns(1).ClearContents

fin: Application.StatusBar = False
Application.EnableCancelKey = xlInterrupt
End Sub
'====================================================================================================
Function PRDX_StatusBar(ByVal sCur#, ByVal sTotal#, Optional ByVal Msg$ = "Progress: ", Optional MsgEsc As Boolean) As Boolean
Dim procCur#, ASU As Boolean
Static sPrev#

procCur = Round(sCur / sTotal, 1)
If sPrev = procCur Then PRDX_StatusBar = True: Exit Function

ASU = Application.ScreenUpdating: Application.ScreenUpdating = True
sPrev = procCur: Application.StatusBar = Msg & Format$(procCur, "0%")

On Error GoTo er: DoEvents: On Error GoTo 0
PRDX_StatusBar = True: Application.ScreenUpdating = ASU: Exit Function

er: If MsgEsc Then MsgBox "«Esc»-button cancel processing!", vbCritical, "StatusBar"
End Function
'====================================================================================================