This post is a little different from usual. It concerns VBA macros for MS Excel. Writing macros is quite easy, but writing efficient macros that run in an acceptable time requires a few tweaks.
Commonly known tweaks include turning off screen updating (see the code below for an example of how this works) and then updating the statusbar to show the user progress (also in the code below).
However, what often frustrates me is the inelegant ways in which a user can exit a macro which could take hours to run. I struggled a little to find the approach demonstrated below so I thought it might be useful for others.
Basic premise is to use error handling to tell Excel to be on the lookout for keyboard cancellations (escape or ctrl-break) and then handle these gracefully.
Private Sub RunLongMacro()
'declare count variables
Dim count As Integer
Dim Total As Integer
Total = 10
'Set the action on an error. In this case go to the label "handleCancel"
On Error GoTo handleCancel
'Turn off screenupdating to increase run speed and start statusbar reporting to user
Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.StatusBar = "Initiliasing..."
'Tell VBA what to do when a cancel key is pressed (Escape or CTRL-BREAK)
'In this case handle the error (Rather than ignore it or present standard error)
Application.EnableCancelKey = xlErrorHandler
'Start the main calculation loop
For count = 1 To Total
'Some additional code might be included here
'Then we calculate the model results
Application.Calculate
'and update the status bar with the count
Application.StatusBar = count & " / " & Total
Next count
'When we're done, we reset the statusbar and screenupdating
Application.StatusBar = False
Application.ScreenUpdating = True
'Next part is the code to handle errors, starting with the specified label
handleCancel:
'If there isn't an error, just skip to the end
'This ensures a single exit point
If Err.Number <> 0 Then
If Err.Number = 18 Then
If MsgBox("You pressed Escape or CTRL-BREAK. Do you want to quit?", vbYesNo, "Quit?") = vbNo Then
Resume
End If
Else: MsgBox "Oops. We encountered an error"
End If
End If
Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic
End Sub
Leave a Reply