For i = 1 To UBound(CementContractNo())
On Error Resume Next
Row = Application.Match(CementContractNo(i), Range("A:A"), 0)
MsgBox Row
CementStartDate(i) = Cells(Row, ContractStartCol).Value
If Cells(Row, ContractExtCol).Value <> "" Then
CementEndDate(i) = Cells(Row, ContractExtCol).Value
Else
CementEndDate(i) = Cells(Row, ContractEndCol).Value
End If
Next i
I am running the above code to find the start date and end date of an excel table. However, it would return an error when the table lookup fails. In this case, I would love to assign a default error value of "Missing" or something else to follow up. Any idea how to do it?
use a construction like this to precisely control what happens when you get an error
On Error Goto ErrHandling
'Your normal code
'at end of sub
ErrHandling:
'[Your code what happens when you get an error]
Resume Next 'will resume at previous location in code.
Read more here: http://www.cpearson.com/excel/errorhandling.htm
Related
I've put together some VBA to find the last row with a certain criterion that matches the current value in my loop, then take action. This VBA code works, until I realized that the worksheet can contain the matching value multiple times but with different dates in another column. So I'm now trying to add a second search criterion to my VBA.
Here is the snippet of VBA as of now.
For Each t In trans.Cells
On Error GoTo NxtT2
If t.Value = Empty Then
On Error GoTo 0
ty = t.Offset(0, -3).Value
tx = t.Offset(0, -6).Value
Set searchTerm = .Range("E:E")
Set where = searchTerm.Find(what:=ty, after:=searchTerm(1), searchdirection:=xlPrevious)
If t.Offset(0, -3).Value = where.Value And IsError(where.Offset(0, 3).Value) Then
t.Value = "#N/A"
End If
End If
NxtT:
On Error GoTo 0
If t.Offset(1, -3).Value = "" Then Exit For
Next t
NxtT2:
Resume NxtT
Basically what I'm trying to do is make the line Set where = searchTerm.Find(what:=ty, after:=searchTerm(1), searchdirection:=xlPrevious) to also include the txvalue along with the ty that is already in there.
Something like this, if possible?
Set where = searchTerm.Find(what:=ty & tx, after:=searchTerm(1), searchdirection:=xlPrevious)
But I know that is not the correct syntax for it.
Any advice on how to approach this in the simplest way?
Not an answer to the original question, but to the issue I created with my off-the-cuff code review.
Your error handling never properly wrapped up. The code still thought it was in the error handler because you "exited" the error handler with the Next, which you really can't do - you need to leave this "instance" of error handling with a Resume.
Give this a shot instead for the cleaned up error handling.
NOTE: I declared variables because I've got Option Explicit set, which you also should also have. I've made the brash assumption that you've got your variables declared outside the code you shared. Use the variables as you've declared them, not as my quickie patched Variant declarations.
Sub foo()
Dim t As Variant
Dim ty As Variant
Dim tx As Variant
For Each t In Cells
On Error GoTo ErrorHandler
If t.Value = Empty Then
On Error GoTo 0
ty = t.Offset(0, -3).Value
tx = t.Offset(0, -6).Value
Dim searchterm As Range
Set searchterm = .Range("E:E")
Dim where As Range
Set where = searchterm.Find(what:=ty, after:=searchterm(1), SearchDirection:=xlPrevious)
If t.Offset(0, -3).Value = where.Value And IsError(where.Offset(0, 3).Value) Then
t.Value = "#N/A"
End If
End If
Continue:
Next
CleanExit:
Exit Sub
ErrorHandler:
If t.Offset(1, -3).Value = "" Then
Resume CleanExit
Else
Resume Continue
End If
End Sub
In the following code, the line .PivotItems("Central Events").Visible = False will throw an error if such pivot item does not exist, hence I am currently ignoring the error with On Error Resume Next:
With BA_view_pivots_sheet.PivotTables("Corporate & Investment Banking").PivotFields( _
"Market")
On Error Resume Next ' ignore error when projects for Central Events does not exist
.PivotItems("Central Events").Visible = False
On Error GoTo 0
End With
However, instead of ignoring the error, I would like to implement a check if such pivot item exists and disable it only in such case. So I came up with something like this, but obviously it won't work, because the object is non- existent:
With BA_view_pivots_sheet.PivotTables("Corporate & Investment Banking").PivotFields( _
"Market")
If Not .PivotItems("Central Events") Is Nothing then
.PivotItems("Central Events").Visible = False
End if
End With
Is there any other way to get around this possible error, apart from ignoring it like in my first code snippet?
I think that you need something like this:
Dim pt As PivotTable, pivot_item As PivotItem
For Each pt In BA_view_pivots_sheet.PivotTables
If pt.Name = "Corporate & Investment Banking" Then 'check that pivot name exists
For Each pivot_item In pt.PivotFields("Market").PivotItems
If pivot_item.Name = "Central Events" Then 'check that item name exists
pivot_item.Visible = False: Exit For
End If
Next pivot_item: Exit For
End If
Next pt
I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function
I am having trouble running a VLookup inside a Change Event sub. I have tested all other lines of code and made sure they work, so it's only the VLookup that's not working.
For brief background, I have two sheets. Sheet1 contains the ID (where it could have multiple IDs on separate line, hence the SPLIT function used below), Sheet 2 contains the ID and its Description. What I wanted to do is perform a VLookup upon value change and insert description for each ID as comment into the cell.
The line that is not working for me is: Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False).
I'm not getting any errors but it jumps right to exitHandler without running the reminder of the logic. I'm certain that the ID exists in the table for the VLookup. If someone can help me point out why it is not working, I will be very appreciated!
Below is a snippet of the code where VLookup is used:
With Target
If .Comment Is Nothing Then
'do nothing
Else
.Comment.Delete
End If
If Target.Value = "" Then
.Comment.Delete
Else
If InStr(Target.Value, vbCrLf) = 0 Then
IDs = Split(Target.Value)
Else
IDs = Split(Target.Value, vbCrLf)
End If
For i = LBound(IDs) To UBound(IDs)
If commentText = "" Then
'Add description for ID as comment
commentText = Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
Else
'Keep on adding description for each ID as comment
commentText = commentText & vbCrLf & Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
End If
Next
.AddComment Text:=commentText
.Comment.Shape.TextFrame.AutoSize = True
End If
End With
exitHandler:
Application.EnableEvents = True
End Sub
As the part of the varible defintions is missing, i would guess that commentText is defined as String. If Vlookup performs a search without a match it will return an error, so the variable has to be defined as Variant otherwise you will get a type mismatch. You wont see the error when you use an On Error Goto-Statement. Also then you should check after a Vlookup if no error occured, i.e with the IsError-Function.
Thank you so much for your replies. Indeed, it should be Application.VLookup and not Application.WorksheetFunction.VLookup. I also had to convert IDs(I) to CLng to prevent 2042 error. Changing commentText to Variant is also needed to see the error code.
In the end, this is what worked for me:
Application.VLookup(CLng(IDs(i)), Sheet2.Range("A3:B30"), 2, False)
Thanks again for all the help!
I've been working with VBA for quite a while now, but I'm still not so sure about Error Handling.
A good article is the one of
CPearson.com
However I'm still wondering if the way I used to do ErrorHandling was/is completely wrong:
Block 1
On Error Goto ErrCatcher
If UBound(.sortedDates) > 0 Then
// Code
Else
ErrCatcher:
// Code
End If
The if clause, because if it is true, will be executed and if it fails the Goto will go into the Else-part, since the Ubound of an Array should never be zero or less, without an Error, this method worked quite well so far.
If I understood it right it should be like this:
Block 2
On Error Goto ErrCatcher
If Ubound(.sortedDates) > 0 Then
// Code
End If
Goto hereX
ErrCatcher:
//Code
Resume / Resume Next / Resume hereX
hereX:
Or even like this:
Block 3
On Error Goto ErrCatcher
If Ubound(.sortedDates) > 0 Then
// Code
End If
ErrCatcher:
If Err.Number <> 0 then
//Code
End If
The most common way I see is that one, that the Error "Catcher" is at the end of a sub and the Sub actually ends before with a "Exit Sub", but however isn't it a little confusing if the Sub is quite big if you jump vice versa to read through the code?
Block 4
Source of the following Code:
CPearson.com
On Error Goto ErrHandler:
N = 1 / 0 ' cause an error
'
' more code
'
Exit Sub
ErrHandler:
' error handling code'
Resume Next
End Sub
Should it be like in Block 3 ?
You've got one truly marvelous answer from ray023, but your comment that it's probably overkill is apt. For a "lighter" version....
Block 1 is, IMHO, bad practice. As already pointed out by osknows, mixing error-handling with normal-path code is Not Good. For one thing, if a new error is thrown while there's an Error condition in effect you will not get an opportunity to handle it (unless you're calling from a routine that also has an error handler, where the execution will "bubble up").
Block 2 looks like an imitation of a Try/Catch block. It should be okay, but it's not The VBA Way. Block 3 is a variation on Block 2.
Block 4 is a bare-bones version of The VBA Way. I would strongly advise using it, or something like it, because it's what any other VBA programmer inherting the code will expect. Let me present a small expansion, though:
Private Sub DoSomething()
On Error GoTo ErrHandler
'Dim as required
'functional code that might throw errors
ExitSub:
'any always-execute (cleanup?) code goes here -- analagous to a Finally block.
'don't forget to do this -- you don't want to fall into error handling when there's no error
Exit Sub
ErrHandler:
'can Select Case on Err.Number if there are any you want to handle specially
'display to user
MsgBox "Something's wrong: " & vbCrLf & Err.Description
'or use a central DisplayErr routine, written Public in a Module
DisplayErr Err.Number, Err.Description
Resume ExitSub
Resume
End Sub
Note that second Resume. This is a trick I learned recently: It will never execute in normal processing, since the Resume <label> statement will send the execution elsewhere. It can be a godsend for debugging, though. When you get an error notification, choose Debug (or press Ctl-Break, then choose Debug when you get the "Execution was interrupted" message). The next (highlighted) statement will be either the MsgBox or the following statement. Use "Set Next Statement" (Ctl-F9) to highlight the bare Resume, then press F8. This will show you exactly where the error was thrown.
As to your objection to this format "jumping around", A) it's what VBA programmers expect, as stated previously, & B) your routines should be short enough that it's not far to jump.
Two main purposes for error handling:
Trap errors you can
predict but can't control the user
from doing (e.g. saving a file to a
thumb drive when the thumb drives
has been removed)
For unexpected errors, present user with a form
that informs them what the problem
is. That way, they can relay that
message to you and you might be able
to give them a work-around while you
work on a fix.
So, how would you do this?
First of all, create an error form to display when an unexpected error occurs.
It could look something like this (FYI: Mine is called frmErrors):
Notice the following labels:
lblHeadline
lblSource
lblProblem
lblResponse
Also, the standard command buttons:
Ignore
Retry
Cancel
There's nothing spectacular in the code for this form:
Option Explicit
Private Sub cmdCancel_Click()
Me.Tag = CMD_CANCEL
Me.Hide
End Sub
Private Sub cmdIgnore_Click()
Me.Tag = CMD_IGNORE
Me.Hide
End Sub
Private Sub cmdRetry_Click()
Me.Tag = CMD_RETRY
Me.Hide
End Sub
Private Sub UserForm_Initialize()
Me.lblErrorTitle.Caption = "Custom Error Title Caption String"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Prevent user from closing with the Close box in the title bar.
If CloseMode <> 1 Then
cmdCancel_Click
End If
End Sub
Basically, you want to know which button the user pressed when the form closes.
Next, create an Error Handler Module that will be used throughout your VBA app:
'****************************************************************
' MODULE: ErrorHandler
'
' PURPOSE: A VBA Error Handling routine to handle
' any unexpected errors
'
' Date: Name: Description:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'03/22/2010 Ray Initial Creation
'****************************************************************
Option Explicit
Global Const CMD_RETRY = 0
Global Const CMD_IGNORE = 1
Global Const CMD_CANCEL = 2
Global Const CMD_CONTINUE = 3
Type ErrorType
iErrNum As Long
sHeadline As String
sProblemMsg As String
sResponseMsg As String
sErrorSource As String
sErrorDescription As String
iBtnCap(3) As Integer
iBitmap As Integer
End Type
Global gEStruc As ErrorType
Sub EmptyErrStruc_S(utEStruc As ErrorType)
Dim i As Integer
utEStruc.iErrNum = 0
utEStruc.sHeadline = ""
utEStruc.sProblemMsg = ""
utEStruc.sResponseMsg = ""
utEStruc.sErrorSource = ""
For i = 0 To 2
utEStruc.iBtnCap(i) = -1
Next
utEStruc.iBitmap = 1
End Sub
Function FillErrorStruct_F(EStruc As ErrorType) As Boolean
'Must save error text before starting new error handler
'in case we need it later
EStruc.sProblemMsg = Error(EStruc.iErrNum)
On Error GoTo vbDefaultFill
EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum)
EStruc.sProblemMsg = EStruc.sErrorDescription
EStruc.sErrorSource = EStruc.sErrorSource
EStruc.sResponseMsg = "Contact the Company and tell them you received Error # " & Str$(EStruc.iErrNum) & ". You should write down the program function you were using, the record you were working with, and what you were doing."
Select Case EStruc.iErrNum
'Case Error number here
'not sure what numeric errors user will ecounter, but can be implemented here
'e.g.
'EStruc.sHeadline = "Error 3265"
'EStruc.sResponseMsg = "Contact tech support. Tell them what you were doing in the program."
Case Else
EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum) & ": " & EStruc.sErrorDescription
EStruc.sProblemMsg = EStruc.sErrorDescription
End Select
GoTo FillStrucEnd
vbDefaultFill:
'Error Not on file
EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum) & ": Contact Tech Support"
EStruc.sResponseMsg = "Contact the Company and tell them you received Error # " & Str$(EStruc.iErrNum)
FillStrucEnd:
Exit Function
End Function
Function iErrorHandler_F(utEStruc As ErrorType) As Integer
Static sCaption(3) As String
Dim i As Integer
Dim iMCursor As Integer
Beep
'Setup static array
If Len(sCaption(0)) < 1 Then
sCaption(CMD_IGNORE) = "&Ignore"
sCaption(CMD_RETRY) = "&Retry"
sCaption(CMD_CANCEL) = "&Cancel"
sCaption(CMD_CONTINUE) = "Continue"
End If
Load frmErrors
'Did caller pass error info? If not fill struc with the needed info
If Len(utEStruc.sHeadline) < 1 Then
i = FillErrorStruct_F(utEStruc)
End If
frmErrors!lblHeadline.Caption = utEStruc.sHeadline
frmErrors!lblProblem.Caption = utEStruc.sProblemMsg
frmErrors!lblSource.Caption = utEStruc.sErrorSource
frmErrors!lblResponse.Caption = utEStruc.sResponseMsg
frmErrors.Show
iErrorHandler_F = frmErrors.Tag ' Save user response
Unload frmErrors ' Unload and release form
EmptyErrStruc_S utEStruc ' Release memory
End Function
You may have errors that will be custom only to your application. This would typically be a short list of errors specifically only to your application.
If you don't already have a constants module, create one that will contain an ENUM of your custom errors. (NOTE: Office '97 does NOT support ENUMS.). The ENUM should look something like this:
Public Enum CustomErrorName
MaskedFilterNotSupported
InvalidMonthNumber
End Enum
Create a module that will throw your custom errors.
'********************************************************************************************************************************
' MODULE: CustomErrorList
'
' PURPOSE: For trapping custom errors applicable to this application
'
'INSTRUCTIONS: To use this module to create your own custom error:
' 1. Add the Name of the Error to the CustomErrorName Enum
' 2. Add a Case Statement to the raiseCustomError Sub
' 3. Call the raiseCustomError Sub in the routine you may see the custom error
' 4. Make sure the routine you call the raiseCustomError has error handling in it
'
'
' Date: Name: Description:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'03/26/2010 Ray Initial Creation
'********************************************************************************************************************************
Option Explicit
Const MICROSOFT_OFFSET = 512 'Microsoft reserves error values between vbObjectError and vbObjectError + 512
'************************************************************************************************
' FUNCTION: raiseCustomError
'
' PURPOSE: Raises a custom error based on the information passed
'
'PARAMETERS: customError - An integer of type CustomErrorName Enum that defines the custom error
' errorSource - The place the error came from
'
' Returns: The ASCII vaule that should be used for the Keypress
'
' Date: Name: Description:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'03/26/2010 Ray Initial Creation
'************************************************************************************************
Public Sub raiseCustomError(customError As Integer, Optional errorSource As String = "")
Dim errorLong As Long
Dim errorDescription As String
errorLong = vbObjectError + MICROSOFT_OFFSET + customError
Select Case customError
Case CustomErrorName.MaskedFilterNotSupported
errorDescription = "The mask filter passed is not supported"
Case CustomErrorName.InvalidMonthNumber
errorDescription = "Invalid Month Number Passed"
Case Else
errorDescription = "The custom error raised is unknown."
End Select
Err.Raise errorLong, errorSource, errorDescription
End Sub
You are now well equipped to trap errors in your program. You sub (or function), should look something like this:
Public Sub MySub(monthNumber as Integer)
On Error GoTo eh
Dim sheetWorkSheet As Worksheet
'Run Some code here
'************************************************
'* OPTIONAL BLOCK 1: Look for a specific error
'************************************************
'Temporarily Turn off Error Handling so that you can check for specific error
On Error Resume Next
'Do some code where you might expect an error. Example below:
Const ERR_SHEET_NOT_FOUND = 9 'This error number is actually subscript out of range, but for this example means the worksheet was not found
Set sheetWorkSheet = Sheets("January")
'Now see if the expected error exists
If Err.Number = ERR_SHEET_NOT_FOUND Then
MsgBox "Hey! The January worksheet is missing. You need to recreate it."
Exit Sub
ElseIf Err.Number <> 0 Then
'Uh oh...there was an error we did not expect so just run basic error handling
GoTo eh
End If
'Finished with predictable errors, turn basic error handling back on:
On Error GoTo eh
'**********************************************************************************
'* End of OPTIONAL BLOCK 1
'**********************************************************************************
'**********************************************************************************
'* OPTIONAL BLOCK 2: Raise (a.k.a. "Throw") a Custom Error if applicable
'**********************************************************************************
If not (monthNumber >=1 and monthnumber <=12) then
raiseCustomError CustomErrorName.InvalidMonthNumber, "My Sub"
end if
'**********************************************************************************
'* End of OPTIONAL BLOCK 2
'**********************************************************************************
'Rest of code in your sub
goto sub_exit
eh:
gEStruc.iErrNum = Err.Number
gEStruc.sErrorDescription = Err.Description
gEStruc.sErrorSource = Err.Source
m_rc = iErrorHandler_F(gEStruc)
If m_rc = CMD_RETRY Then
Resume
End If
sub_exit:
'Any final processing you want to do.
'Be careful with what you put here because if it errors out, the error rolls up. This can be difficult to debug; especially if calling routine has no error handling.
Exit Sub 'I was told a long time ago (10+ years) that exit sub was better than end sub...I can't tell you why, so you may not want to put in this line of code. It's habit I can't break :P
End Sub
A copy/paste of the code above may not work right out of the gate, but should definitely give you the gist.
I definitely wouldn't use Block1. It doesn't seem right having the Error block in an IF statement unrelated to Errors.
Blocks 2,3 & 4 I guess are variations of a theme. I prefer the use of Blocks 3 & 4 over 2 only because of a dislike of the GOTO statement; I generally use the Block4 method. This is one example of code I use to check if the Microsoft ActiveX Data Objects 2.8 Library is added and if not add or use an earlier version if 2.8 is not available.
Option Explicit
Public booRefAdded As Boolean 'one time check for references
Public Sub Add_References()
Dim lngDLLmsadoFIND As Long
If Not booRefAdded Then
lngDLLmsadoFIND = 28 ' load msado28.tlb, if cannot find step down versions until found
On Error GoTo RefErr:
'Add Microsoft ActiveX Data Objects 2.8
Application.VBE.ActiveVBProject.references.AddFromFile _
Environ("CommonProgramFiles") + "\System\ado\msado" & lngDLLmsadoFIND & ".tlb"
On Error GoTo 0
Exit Sub
RefErr:
Select Case Err.Number
Case 0
'no error
Case 1004
'Enable Trust Centre Settings
MsgBox ("Certain VBA References are not available, to allow access follow these steps" & Chr(10) & _
"Goto Excel Options/Trust Centre/Trust Centre Security/Macro Settings" & Chr(10) & _
"1. Tick - 'Disable all macros with notification'" & Chr(10) & _
"2. Tick - 'Trust access to the VBA project objects model'")
End
Case 32813
'Err.Number 32813 means reference already added
Case 48
'Reference doesn't exist
If lngDLLmsadoFIND = 0 Then
MsgBox ("Cannot Find Required Reference")
End
Else
For lngDLLmsadoFIND = lngDLLmsadoFIND - 1 To 0 Step -1
Resume
Next lngDLLmsadoFIND
End If
Case Else
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
End
End Select
On Error GoTo 0
End If
booRefAdded = TRUE
End Sub
I keep things simple:
At the module level I define two variables and set one to the name of the module itself.
Private Const ThisModuleName As String = "mod_Custom_Functions"
Public sLocalErrorMsg As String
Within each Sub/Function of the module I define a local variable
Dim ThisRoutineName As String
I set ThisRoutineName to the name of the sub or function
' Housekeeping
On Error Goto ERR_RTN
ThisRoutineName = "CopyWorksheet"
I then send all errors to an ERR_RTN: when they occur, but I first set the sLocalErrorMsg to define what the error actually is and provide some debugging info.
If Len(Trim(FromWorksheetName)) < 1 Then
sLocalErrorMsg = "Parameter 'FromWorksheetName' Is Missing."
GoTo ERR_RTN
End If
At the bottom of each sub/function, I direct the logic flow as follows
'
' The "normal" logic goes here for what the routine does
'
GoTo EXIT_RTN
ERR_RTN:
On Error Resume Next
' Call error handler if we went this far.
ErrorHandler ThisModuleName, ThisRoutineName, sLocalErrorMsg, Err.Description, Err.Number, False
EXIT_RTN:
On Error Resume Next
'
' Some closing logic
'
End If
I then have a seperate module I put in all projects called "mod_Error_Handler".
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Subroutine Name: ErrorHandler '
' '
' Description: '
' This module will handle the common error alerts. '
' '
' Inputs: '
' ModuleName String 'The name of the module error is in. '
' RoutineName String 'The name of the routine error in in. '
' LocalErrorMsg String 'A local message to assist with troubleshooting.'
' ERRDescription String 'The Windows Error Description. '
' ERRCode Long 'The Windows Error Code. '
' Terminate Boolean 'End program if error encountered? '
' '
' Revision History: '
' Date (YYYYMMDD) Author Change '
' =============== ===================== =============================================== '
' 20140529 XXXXX X. XXXXX Original '
' '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
Public Sub ErrorHandler(ModuleName As String, RoutineName As String, LocalErrorMsg As String, ERRDescription As String, ERRCode As Long, Terminate As Boolean)
Dim sBuildErrorMsg As String
' Build Error Message To Display
sBuildErrorMsg = "Error Information:" & vbCrLf & vbCrLf
If Len(Trim(ModuleName)) < 1 Then
ModuleName = "Unknown"
End If
If Len(Trim(RoutineName)) < 1 Then
RoutineName = "Unknown"
End If
sBuildErrorMsg = sBuildErrorMsg & "Module Name: " & ModuleName & vbCrLf & vbCrLf
sBuildErrorMsg = sBuildErrorMsg & "Routine Name: " & RoutineName & vbCrLf & vbCrLf
If Len(Trim(LocalErrorMsg)) > 0 Then
sBuildErrorMsg = sBuildErrorMsg & "Local Error Msg: " & LocalErrorMsg & vbCrLf & vbCrLf
End If
If Len(Trim(ERRDescription)) > 0 Then
sBuildErrorMsg = sBuildErrorMsg & "Program Error Msg: " & ERRDescription & vbCrLf & vbCrLf
If IsNumeric(ERRCode) Then
sBuildErrorMsg = sBuildErrorMsg & "Program Error Code: " & Trim(Str(ERRCode)) & vbCrLf & vbCrLf
End If
End If
MsgBox sBuildErrorMsg, vbOKOnly + vbExclamation, "Error Detected!"
If Terminate Then
End
End If
End Sub
The end result is a pop-up error message teling me in what module, what soubroutine, and what the error message specifically was. In addition, it also will insert the Windows error message and code.
Block 2 doesn't work because it doesn't reset the Error Handler potentially causing an endless loop. For Error Handling to work properly in VBA, you need a Resume statement to clear the Error Handler. The Resume also reactivates the previous Error Handler. Block 2 fails because a new error would go back to the previous Error Handler causing an infinite loop.
Block 3 fails because there is no Resume statement so any attempt at error handling after that will fail.
Every error handler must be ended by exiting the procedure or a Resume statement. Routing normal execution around an error handler is confusing. This is why error handlers are usually at the bottom.
But here is another way to handle an error in VBA. It handles the error inline like Try/Catch in VB.net There are a few pitfalls, but properly managed it works quite nicely.
Sub InLineErrorHandling()
'code without error handling
BeginTry1:
'activate inline error handler
On Error GoTo ErrHandler1
'code block that may result in an error
Dim a As String: a = "Abc"
Dim c As Integer: c = a 'type mismatch
ErrHandler1:
'handle the error
If Err.Number <> 0 Then
'the error handler has deactivated the previous error handler
MsgBox (Err.Description)
'Resume (or exit procedure) is the only way to get out of an error handling block
'otherwise the following On Error statements will have no effect
'CAUTION: it also reactivates the previous error handler
Resume EndTry1
End If
EndTry1:
'CAUTION: since the Resume statement reactivates the previous error handler
'you must ALWAYS use an On Error GoTo statement here
'because another error here would cause an endless loop
'use On Error GoTo 0 or On Error GoTo <Label>
On Error GoTo 0
'more code with or without error handling
End Sub
Sources:
http://www.cpearson.com/excel/errorhandling.htm
http://msdn.microsoft.com/en-us/library/bb258159.aspx
The key to making this work is to use a Resume statement immediately followed by another On Error statement. The Resume is within the error handler and diverts code to the EndTry1 label. You must immediately set another On Error statement to avoid problems as the previous error handler will "resume". That is, it will be active and ready to handle another error. That could cause the error to repeat and enter an infinite loop.
To avoid using the previous error handler again you need to set On Error to a new error handler or simply use On Error Goto 0 to cancel all error handling.
This is what I'm teaching my students tomorrow. After years of looking at this stuff... ie all of the documentation above http://www.cpearson.com/excel/errorhandling.htm comes to mind as an excellent one...
I hope this summarizes it for others. There is an Err object and an active (or inactive) ErrorHandler. Both need to be handled and reset for new errors.
Paste this into a workbook and step through it with F8.
Sub ErrorHandlingDemonstration()
On Error GoTo ErrorHandler
'this will error
Debug.Print (1 / 0)
'this will also error
dummy = Application.WorksheetFunction.VLookup("not gonna find me", Range("A1:B2"), 2, True)
'silly error
Dummy2 = "string" * 50
Exit Sub
zeroDivisionErrorBlock:
maybeWe = "did some cleanup on variables that shouldnt have been divided!"
' moves the code execution to the line AFTER the one that errored
Resume Next
vlookupFailedErrorBlock:
maybeThisTime = "we made sure the value we were looking for was in the range!"
' moves the code execution to the line AFTER the one that errored
Resume Next
catchAllUnhandledErrors:
MsgBox(thisErrorsDescription)
Exit Sub
ErrorHandler:
thisErrorsNumberBeforeReset = Err.Number
thisErrorsDescription = Err.Description
'this will reset the error object and error handling
On Error GoTo 0
'this will tell vba where to go for new errors, ie the new ErrorHandler that was previous just reset!
On Error GoTo ErrorHandler
' 11 is the err.number for division by 0
If thisErrorsNumberBeforeReset = 11 Then
GoTo zeroDivisionErrorBlock
' 1004 is the err.number for vlookup failing
ElseIf thisErrorsNumberBeforeReset = 1004 Then
GoTo vlookupFailedErrorBlock
Else
GoTo catchAllUnhandledErrors
End If
End Sub