How to stop code from executing after error? - vba

My form allows users to filter by various controls, including a search box for strings. A separate function, CalculateSearchString, processes this search field for filtering (keywords, exact phrases etc); and within this function I use error handling to trap errors caused by incorrect user input (i.e. mucking up the punctuation). The error handling works without a hitch, but I would like the code to come to a complete stop if the search input is incorrect.
What I want:
user inputs incorrectly formatted search string, clicks on the filter
function CalculateSearchFilter throws error. Message box: "fix your search terms!"
code stops completely, and filter is not applied
What actually happens:
user inputs incorrectly formatted search string, clicks on the filter
function CalculateSearchFilter throws error. Message box: "fix your search terms!" Exit function
calling procedure cmdFilterOn still runs, applying an incomplete filter (as though the search box had been empty)
Question: How do I halt code execution completely, not just in the function but in its calling procedure(s)? The function is used in more than one place, so merging it with the calling procedure is not practical.
Private Sub cmdFilterOn()
Dim strSearch As String
strSearch = CalculateSearchFilter
'do more stuff
End Sub
Private Function CalculateSearchFilter() As String
On Error GoTo ErrHandler
'do stuff
If 'user input is wrong, then raise a custom error:
Err.Raise 50000
End If
ExitHandler:
Exit Function
ErrHandler:
If Err.Number = 50000 Then msgbox "Fix your search terms!"
Resume ExitHandler
End Sub
Private Sub cmdYetAnotherButton()
'which also calls on CalculateSearchFilter
End Sub
Moving the input validation to the calling procedure isn't practical either, as it would force me to repeat much of the code in CalculateSearchFilter().
(As I was writing this another solution occurred to me, which is to set CalculateSearchFilter = "an error occurred" in the function error handler, and in the calling procedure
If CalculateSearchFilter = "an error occurred" Then Exit Sub
...but is there a more "official" answer?)

You could try to return a boolean value instead
Option Explicit
Private Sub cmdFilterOn()
Dim strSearch As String
If CalculateSearchFilter(strSearch) Then
'do more stuff
End If
End Sub
Private Function CalculateSearchFilter(ByRef strSearch As String) As Boolean
On Error GoTo ErrHandler
'do stuff
If 'user input is wrong, then raise a custom error:
Err.Raise 50000
End If
CalculateSearchFilter = True
ExitHandler:
Exit Function
ErrHandler:
If Err.Number = 50000 Then MsgBox "Fix your search terms!"
CalculateSearchFilter = False
Resume ExitHandler
End Function
Private Sub cmdYetAnotherButton()
'which also calls on CalculateSearchFilter
End Sub
Alternative:
As mentioned in the comments if you would like to get a string back then I would return an empty string. I would not recommend to return a string like an error occured or whatsoever
Option Explicit
Private Sub cmdFilterOn()
Dim strSearch As String
strSearch = CalculateSearchFilter
If Len(strSearch) > 0 Then
'do more stuff
End If
End Sub
Private Function CalculateSearchFilter() As String
On Error GoTo ErrHandler
'do stuff
If 'user input is wrong, then raise a custom error:
Err.Raise 50000
End If
ExitHandler:
Exit Function
ErrHandler:
If Err.Number = 50000 Then MsgBox "Fix your search terms!"
CalculateSearchFilter = vbNullString
Resume ExitHandler
End Function
Private Sub cmdYetAnotherButton()
'which also calls on CalculateSearchFilter
End Sub

Related

VBA 5097 Error when updating the Content Controls from the user form

I have a user form which updates around 650 Content Controls in the Word Document. It works fine when the Track Changes function is disabled. When the user would like to Track Changes they are getting an error message 5097 in SubmitEndorsement function. Content Control labels are not locked in the file.
Private Sub b_Submit_Click()
On Error GoTo ErrHandler
For Each openDoc In Application.Documents
openDoc.Activate
If ActiveDocument.SelectContentControlsByTag("UniqueDocN").Count > 0 Then
If ActiveDocument.SelectContentControlsByTag("UniqueDocN").Item(1).Range.Text = UniqueDocNumber Then
SubmitEndorsement
End If
End If
Next openDoc
Adios:
Exit Sub
ErrHandler:
MsgBox "Uh oh - an error has occurred with Function UserForm_Submit ."
Resume Adios
Resume
End Sub
Sub SubmitEndorsement()
On Error GoTo ErrHandler
Call updateControl("CCProgramme", "txt_Programme")
Adios:
Exit Sub
ErrHandler:
MsgBox "Uh oh - an error has occurred with Function SubmitEndorsement."
Resume Adios
Resume
End Sub
Sub updateControl(ctl_name As String, txtBox_name As String)
With ActiveDocument
If UserForm.Controls(txtBox_name).value <> .SelectContentControlsByTag(ctl_name).Item(1).Range.Text Then
.SelectContentControlsByTag(ctl_name).Item(1).Range.Text = UserForm.Controls(txtBox_name).value
End If
End With
End Sub

Error handling forms which call sub procedures - MS Access VBA

Yes, Access is used and it cannot be changed.
I have a form class object, let's say:
Option Compare Database
Private Sub cmdCalculate_Click()
Dim Employee As String
Employee = InputBox("Enter Name of Employee")
If InStr(Employee, "Eka") > 0 Then
Call Hello
Else
Call Hello2
End If
End Sub
And I have one module. As you can see, I call each procedure from my form.
Option Compare Database
Option Explicit
Public Sub Hello()
MsgBox "Hello Eka"
End Sub
Public Sub Hello2()
MsgBox "Hello stranger"
End Sub
The issue I have is with the error handling implementation as here we have the subsequent procedures which I call. I tried to add a simple On Error GoTo - see below to an individual sub-procedure to display a nice message and break the entire script execution but yes, the sub procedure will show a nice message, you click OK to close it and the main script just continues running. Can you, please, direct me to a source where I can read more on the potential solution or assist with it? I found something about global error handling, but not sure if it is relevant.
Private Sub cmdCalculate_Click()
On Error GoTo errormessage
#TO-DO. VBA Code
Exit Sub
errormessage:
MsgBox "An error has occured. Please check your work."
End Sub
Here is a small sample.
MainProcedure calls SubProcedure1 and this calls SubProcedure2.
In SubProcedure2 there will be a division by zero error.
SubProcedure2 handles this error and reraise it to the upper procedure in the call stack: SubProcedure1.
SubProcedure1 also handles it and also reraises it, now to MainProcedure.
MainProcedure now shows the error. It can stop execution now if you want that.
Remark1: VBA unfortunately has no call stack information you could read at runtime. So in my example I always add the current procedurename as a new line to the top of the source property of the error.
So finally you can see where the error happened and how the call stack was.
But that is just an example.
Remark2: If you, for example, wouldn't place an active error handler in SubProcedure1 the error would bubble up itself to MainProcedure, but then you couldn't add your call stack information.
Public Sub MainProcedure()
On Error GoTo Catch
SubProcedure1
Finally:
Exit Sub
Catch:
MsgBox Err.Number & " : " & Err.Description & vbNewLine & vbNewLine & "- MainProcedure" & vbNewLine & Err.Source, vbCritical
Resume Finally
End Sub
Public Sub SubProcedure1()
On Error GoTo Catch
SubProcedure2
Finally:
Exit Sub
Catch:
Err.Raise Err.Number, "- SubProcedure2" & vbNewLine & Err.Source, Err.Description
Resume Finally
End Sub
Public Sub SubProcedure2()
On Error GoTo Catch
Dim value As Long
value = 0
Dim value2 As Long
value2 = 1 / value
Finally:
Exit Sub
Catch:
Err.Raise Err.Number, "- SubProcedure2" & vbNewLine & Err.Source, Err.Description
Resume Finally
End Sub

On error exit sub and return error to sub that called erroneous sub

Some background:
Precursor: I have looked around SO at the other Error Handling questions, but I haven't been able to fully apply the answers to my situation. I feel like Err.Raise is how I would accomplish what I'll describe below. But, I'm not sure how to implement it in the way I need. If I were to use Err.Raise how would I exit the Sub1-15 first before raising the error code in the main sub?
That being said,
I have a large Excel VBA project that performs a plethora of different routines. I chose to call all routines from one main routine for means of later maintenance on the individual routines. I have an On Error handler in my main sub that I would like to have triggered if an error is thrown in any of the routines called from that main routine.
Is there a way to:
Record the
Error type that occurred
Error message
Sub that raises the error
On Error exit that sub to return to the main sub, then
Raise the error that just occurred in the other sub so that the NotifyandRepair Error Handler is called?
I have the following situation
Sub MainSub()
On Error GoTo NotifyandCorrect
Call Sub1
Call Sub2
...
Call Sub15
Exit Sub
NotifyandCorrect:
'Send copy of faulty file, the error code and Sub that caused it
'Then stop macro execution completely
End Sub
Sub Sub1()
On Error Exit Sub1 and raise current Error in MainSub(?)
'Perform data checks
End Sub
Sub Sub2()
On Error Exit Sub2 and raise current Error in MainSub(?
'Modify data groups
End Sub
Sub Sub15()
On Error Exit Sub15 and raise current Error in MainSub(?
'Clean up work
End Sub
Is there anyway I can avoid having to do something like below for each of Sub1-Sub15?
Sub MainSub()
On Error GoTo NotifyandCorrect
Call Sub1
Call Sub2
...
Call Sub15
Exit Sub
NotifyandCorrect:
'Send copy of faulty file, the error code and Sub that caused it
'Then stop macro execution completely
End Sub
...
...
Sub Sub15()
On Error Goto HaltExecution
'Clean up work
Exit Sub
HaltExecution:
'Note Error message & type
'Note that Sub15 is where error occurred
End Sub
Closing Questions
Is this at all possible?
If this isn't possible, how should I handle this to do something like what I described? What would you suggest (please provide an example if you can)
You need to handle errors in your "child" methods, and have them "re-throw" the error (using Err.Raise in the error handler subroutine) so the caller gets to see it - when re-throwing, specify the method's name as the "source". The following code produces this output:
5 Invalid procedure call or argument DoSomething1
9 Subscript out of range DoSomething2
Public Sub MainSub()
On Error GoTo ErrHandler
DoSomething1
DoSomething2
Exit Sub
ErrHandler:
Debug.Print Err.Number, Err.Description, Err.Source
Resume Next
End Sub
Private Sub DoSomething1()
On Error GoTo ErrHandler
Err.Raise 5
Exit Sub
ErrHandler:
Err.Raise Err.Number, "DoSomething1", Err.Description
End Sub
Private Sub DoSomething2()
On Error GoTo ErrHandler
Err.Raise 9
Exit Sub
ErrHandler:
Err.Raise Err.Number, "DoSomething2", Err.Description
End Sub
Is there anyway I can avoid having to do something like below for each of Sub1-Sub15?
No. Each procedure must handle runtime errors, there's no way around it.
Specifying method names in hard-coded strings is annoying. By encapsulating each procedure into its own object (say, some ICommand implementation), you can achieve the same result by leveraging the TypeName function:
Module1
Option Explicit
Public Sub MainSub()
On Error GoTo ErrHandler
RunCommand New DoSomething1
RunCommand New DoSomething2
Exit Sub
ErrHandler:
Debug.Print Err.Number, Err.Description, Err.Source
Resume Next
End Sub
Private Sub RunCommand(ByVal command As ICommand)
command.Execute
End Sub
ICommand (class module)
Public Sub Execute()
End Sub
DoSomething1 (class module)
Option Explicit
Implements ICommand
Private Sub ICommand_Execute()
On Error GoTo ErrHandler
Err.Raise 5
ErrHandler:
Err.Raise Err.Number, TypeName(Me), Err.Description
End Sub
DoSomething2 (class module)
Option Explicit
Implements ICommand
Private Sub ICommand_Execute()
On Error GoTo ErrHandler
Err.Raise 9
ErrHandler:
Err.Raise Err.Number, TypeName(Me), Err.Description
End Sub
The ICommand interface isn't really needed, but formalizes the way each DoSomething command is to be called. The idea is to have an object to implement each procedure - that way you can have TypeName(Me) as your error source, and never need to hard-code a string. You'll have 15 methods in 15 dedicated class modules, instead of 15 procedures in a single standard module.
You can use Err.Number and Err.Description to get info about the error.
Next, I would suggest creating a temp string and updating it whenever a new sub is entered. such as:
Sub Sub1()
temp= "sub1"
...
End Sub
Sub Sub2()
temp= "sub2"
...
End Sub
So whenever an error is handled, the string temp holds the value of the sub it occurred in.

Passing Listbox object in vba Access

I'm trying to pass a listbox to another sub to populate it, this is designed to allow multiple listboxes to use the same code by passing the name of the listbox, and the name of the table (which checks whether the input is valid) to the sub. At the moment the me.Autoclavelist (which is the name of the listbox on this particular form) in the below code displays 'null' when you hover over it.
1) What is the listbox object actually expecting as input?
2) Subs 1 and 2 appear to work even with the null being sent - however similar code using a .removeitem doesn't (3 & 4) why is this?
Thanks!
Edit: I found the issue here - I had locked the listboxes on the forms. This meant that it wasn't possible to select any items in them, and the value was therefore always null, so the second two subs failed.
Sub 1:
Private Sub cmdAutoClaveAddItem_Click()
On Error GoTo Errorhandler
Call AddtoList(Me.AutoClaveList, "[Autoclave Process]")
If Me.AutoClaveList.ListCount <> 0 Then
Me.cmdRunAutoclave.Enabled = True
Me.CmdRemoveItem.Enabled = True
End If
SubExit:
Exit Sub
Errorhandler:
MsgBox Error$
Resume SubExit
End Sub
Sub 2:
Private Sub AddtoList(ListName As Listbox, FormName As String)
On Error GoTo Errorhandler
Dim StrLabel_Id As String
Dim l As Long
ListName.RowSourceType = "Value List"
StrLabel_Id = InputBox("Scan Tray Label", "Scan")
If StrLabel_Id = "" Then
GoTo SubExit
Else
If Not IsNull(DLookup("[Tracking_Label_ID]", "Label_Production", "[Tracking_Label_ID]='" & StrLabel_Id & "'")) Then
If IsNull(DLookup("[Tracking_Label_ID]", FormName, "[Tracking_Label_ID]='" & StrLabel_Id & "'")) Then
l = 0
For l = 0 To (ListName.ListCount - 1) Step 1
If ListName.ItemData(l) = StrLabel_Id Then
Call MsgBox("Label is already in batch!", , "Error")
GoTo SubExit
End If
Next
ListName.AddItem StrLabel_Id
Else
Call MsgBox("Label has already been processed", , "Error")
End If
Else
Call MsgBox("Label does not exist. Make sure you create label in Label Production", , "Error")
End If
End If
SubExit:
Exit Sub
Errorhandler:
MsgBox Error$
Resume SubExit
End Sub
Sub 3:
Private Sub CmdRemoveItem_Click()
On Error GoTo Errorhandler
Call RemovelistItem(AutoClaveList)
SubExit:
Exit Sub
Errorhandler:
MsgBox Error$
Resume SubExit
End Sub
Sub 4:
Private Sub RemovelistItem(ListName As Listbox)
On Error GoTo Errorhandler
Dim strRemoveItem As String
If Not IsNull(ListName.Value) Then
strRemoveItem = ListName.Value
ListName.RemoveItem (strRemoveItem)
Else
GoTo SubExit
End If
SubExit:
ListName.Requery
Exit Sub
Errorhandler:
MsgBox Error$
Resume SubExit
End Sub
Don't worry about the Null. The object exists and is just fine. The default property of ListBox objects is Value; therefore the value of Value is what gets displayed when you mouse over Me.AutoClaveList. Its Value happens to be Null (which it is by default):
Null Indicates the item is in a null state, neither selected nor cleared.
For more info, you can have a look at ListName and its properties in the Locals window.
Of course, if you do this:
If Not IsNull(ListName.Value) Then
'do stuff
Else
GoTo SubExit
End If
then it "won't work" i.e. will not do anything because .Value is Null. Get rid of that condition.

visual basic for application - error handling

I have never worked with VBA, therefore this could by an easy task, but I can't get it working :-) Simply I need to catch a run time error in following code :
Private Sub CheckBox1_Click()
ActiveWorkbook.Sheets("(X)").Unprotect
ActiveWorkbook.Sheets("(X)").Select
ActiveSheet.Range("F18").Select
'here comes the error
ActiveSheet.Range("$A$2:$X$310").AutoFilter Field:=1, Criteria1:="1"
Sheets("(40 UKÁŽKA)").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Welcome to old school error handling.
What you are looking for is either
Sub MySub()
On Error Resume Next
DoMyStuff()
End Sub
if you want to swallow this issue, e.g equivalent of Try Catch End
or
Sub MySub()
On Error Goto ErrorHandler
DoMyStuff()
KeepGoing :
DoSomeMoreStuffAnyway()
Exit Sub
ErrorHandler:
HandleTheError()
Exit Sub
You can get the Error number from the variable Err
You can also fix and call Resume to go to the next line of code after the error happened
You can also do Resume To a lable e.g. Resume KeepGoing in the above.
More info here MSDN VBA Error Handling
Use On Error. See this for a good discussion of the topic.
On Error GoTo ErrHandler
<do things>
On Error GoTo 0 'Turn default error handling back on
Exit Sub
ErrHandler:
If Error.Number = xxxx Then
<error processing>
End If
(then Resume )(or Resume Next) (or do nothing & let sub end)
End Sub