I'll tell you what I usually do. I have a sub routine specifically for exiting the macro (I call it exitPoint), and I have a sub routine controling the flow (I call it main), at the begining of main I have a boolean called badExit set to true, and at the end of main I set it to false, then finally call exitPoint. Each sub routine or function has an error trap which will pass control over to ExitPoint with a string saying which routine the error was in. exitPoint then runs a series of clean up and error handeling code, depending on wether the badExit was true or false.
Bascially the idea for this is I would be providing support, if it was a macro I was handing off to someone never to see it again I would put a lot more defensive coding and helpful error messages in there - you can test for an error number and give a specific message for that for example.
SO something like this (this is an actual macro that i've cut lots of code out of just to illustrate):
Option Explicit
Option Private Module
...
Private mbBadExit As Boolean
Private msMacroWbName As String
Private msMacroWbPath As String
Private miSaveFormat As String
Private miSheetsInNewWb As String
Private mcolWorkbooks As New Collection
Private mwbkNew As Workbook
...
Sub Main()
' ---------------------------------------------------------------------
' Control procedure
' ---------------------------------------------------------------------
Debug.Print "Main Start " & Time
'set exit state
mbBadExit = True
'set macro document name and path
msMacroWbName = ThisWorkbook.Name
msMacroWbPath = ThisWorkbook.Path
miSaveFormat = Application.DefaultSaveFormat
miSheetsInNewWb = Application.SheetsInNewWorkbook
'disable some default application behaviours for macro effeciency
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.DisplayStatusBar = False
.DefaultSaveFormat = xlOpenXMLWorkbook 'for excel 2007 compatability
.SheetsInNewWorkbook = 3
End With
Debug.Print "AddNew Start " & Time
AddNew 'creates new workbook which the rest of the macro works with
Debug.Print "Import Start " & Time
Import 'import bobj CP_Import file and scalepoint data
Debug.Print "Transform Start " & Time
Transform 'various data munging to final state
mbBadExit = False 'set exit state for clean exit
Debug.Print "ExitPoint Start " & Time
ExitPoint 'single exit point
End Sub
Private Sub ExitPoint(Optional ByVal sError As String)
' ---------------------------------------------------------------------
' Single exit point for macro, handles errors and clean up
' ---------------------------------------------------------------------
Dim mwbk As Workbook
'return application behaviour to normal
On Error GoTo 0
With Application
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
.DisplayStatusBar = True
.DefaultSaveFormat = miSaveFormat
.SheetsInNewWorkbook = miSheetsInNewWb
End With
'handle good or bad exit
If mbBadExit = False Then 'no problem
MsgBox "Process complete"
'close this workbook, leaving result workbook open
Application.DisplayAlerts = False
Set mcolWorkbooks = Nothing 'destroy collection object
Workbooks(msMacroWbName).Close 'close macro wbk
Application.DisplayAlerts = True
Else 'an error occured
'show user error details
MsgBox prompt:="Macro process has ended prematurely. Contact ... for support." _
& IIf(sError <> vbNullString, vbCrLf & sError, vbNullString) & vbCrLf _
& Err.Description, Title:="Error " & IIf(Err.Number <> 0, Err.Number, vbNullString)
On Error Resume Next
'clean up open workbooks
For Each mwbk In mcolWorkbooks
mwbk.Close
Next
End If
Debug.Print "Finish " & Time
End
End Sub
Private Sub AddNew()
' ---------------------------------------------------------------------
' Creates new workbook which is the base workbook for
' The rest of the macro
' ---------------------------------------------------------------------
On Error GoTo errTrap
Set mwbkNew = Workbooks.Add
mcolWorkbooks.Add mwbkNew
With mwbkNew
.Title = "CP HR Import"
.Subject = "CP HR Import"
End With
Exit Sub
errTrap:
ExitPoint ("Error in AddNew sub routine") 'pass control to error handling exitpoint sub
End Sub
Private Sub Import()
' ---------------------------------------------------------------------
' Connect to source file (xlsx) with ADO, pull data into a recordset
' with SQL, then pull data to the workbook from the recordset to a
' querytable. Kill connection etc..
' ---------------------------------------------------------------------
On Error GoTo errTrap
...Code here...
Exit Sub
errTrap:
ExitPoint ("Error in Import sub routine") 'pass control to error handling exitpoint sub
End Sub
Sub Transform()
' ---------------------------------------------------------------------
' Looks for records with an increment date and inserts a new record
' showing the new scalepoint from the increment date with the new
' salary
' ---------------------------------------------------------------------
On Error GoTo errTrap
...code here...
Exit Sub
errTrap:
ExitPoint ("Error in Transform sub routine") 'pass control to error handling exitpoint sub
End Sub
Sub ColumnsToText(rngColumns As Range)
' ---------------------------------------------------------------------
' Takes a column as a range and converts to text. UK date safe but
' not robust, use with care.
' ---------------------------------------------------------------------
Dim avDates As Variant
avDates = rngColumns.Value
With rngColumns
.NumberFormat = "@"
.FormulaLocal = avDates
End With
Exit Sub
errTrap:
ExitPoint ("Error in ColumnsToText sub routine") 'pass control to error handling exitpoint sub
End Sub