Exit VBA Main Subroutine from Called Subroutine - vba

I have a sub "main" which calls sub "prepare" as well as other subroutines. I have an if statement in "prepare" that exits the sub if a condition is met. However, it only exits that specific subroutine and then goes on to execute all of the other subroutines in "main".
If oAltIDLocationDictionary.Exists(sAltID) Then
MsgBox "It appears that there are two duplicate ID's in your alternate ID list. Duplicate ID's cannot be processed, please consolidate the location information into a single ID or remove the duplicate ID from the Alt-ID list."
Exit Sub
End If
Is there a way to exit the "main" from the "prepare" sub it's calling so that when the condition is met in the "prepare" sub the "main" sub stops and no further code is executed?

To cease execution of your macro immediately, without returning to the calling procedure, you can use the End statement.

You can convert the subs into functions, and if the functions return a certain value, the main sub will then exit.
Sub Main()
Dim bTest As Boolean
' blah blah
bTest = Prepare
If bTest Then Exit Sub
' blah blah
End Sub
Function Prepare() As Boolean
Prepare = False
If oAltIDLocationDictionary.Exists(sAltID) Then
MsgBox "It appears that there are two duplicate ID's in your alternate ID list."
Prepare = True
Exit Function
End If
End Function

Related

Simple Error Handling for GoTo or Other

I'm attempting to create a macro that will allow a User to click a button and the excel sheet will either 1: Move to the next/previous sheet or 2: Copy existing sheet and then move to the copied sheet.
Currently I'm stuck dealing w/ a error handling situation and am not sure how to get around it. I'm not sure if I'm using the On Error correctly. Essentially I need it to go to my next sub if a page doesn't exist. If the page does exist, to simply ActiveSheet.Index + 1 then select.
Sub Function1()
On Error GoTo fixer
Sheets(ActiveSheet.Index + 1).Select
fixer:
Call Copier2
End Sub
Sub Copier2()
ActiveWorkbook.ActiveSheet.Copy _
After:=ActiveWorkbook.ActiveSheet
End Sub
Any help is greatly appreciated, I'm quite a novice at this stuff so don't be afraid to dumb it down for me.
Let's have some fun with this, to illustrate the mechanics.
First let's extract a method whose job is to activate a given worksheet. That method will return a Boolean value that indicates whether it succeeded or not. Because we want to return a value, this will be a Function procedure:
Private Function ActivateSheet(ByVal index As Long) As Boolean
Dim result As Boolean
On Error GoTo CleanFail
ActiveWorkbook.Sheets(index).Select
result = True
CleanExit:
ActivateSheet = result
Exit Function
CleanFail:
Err.Clear
result = False
Resume CleanExit
End Function
The "happy path" assigns result to True and then assigns the function's return value to result and then returns.
The "error path" jumps to CleanFail, which clears the error (likely some index out of bounds error), assigns result to False and then Resume CleanExit clears the error-handling state and resumes to CleanExit, which assigns the function's return value to result and then returns.
The macro can do this now:
Public Sub NavigateRight()
If Not ActivateSheet(ActiveSheet.Index + 1) Then
'copy the current sheet if there's no next sheet:
ActiveSheet.Copy After:=ActiveSheet
End If
End Sub
And we can also have this one:
Public Sub NavigateLeft()
If Not ActivateSheet(ActiveSheet.Index - 1) Then
'copy the current sheet if there's no previous sheet:
ActiveSheet.Copy Before:=ActiveSheet
End If
End Sub
Don't make procedures just for the sake of making procedures: use them to abstract concepts: a procedure like Copier2 doesn't really need to exist, it's just wrapping a single call against the Excel object model - better to inline it IMO.

VBA prevent closing of UserForm with "End" in code

In my spreadsheet, I have a UserForm that is supposed to be open at all times.
Once in a while, my code will contain an "End" where I exit the code based on some if statement.
The problem is that this closes the UserForm, is there a way to prevent this from happening?
EDIT:
Sub Test1()
'Random code
Call Test2(Variable)
'Random code
End Sub
Sub Test2(ByVal Variable as Double)
If Variable = 0 then
'Random code
End If
If Variable = 1 then
Call Test3
End 'Original placement of End
End If
End Sub
Sub Test3()
'Random code
End Sub
This is a rough example of how the code is build (its rather long at this point). So depending on the "variable" different things happen in Test2. But if the Variable is 1, then the "random code" back in Test1 can't be executed thus, so I have to stop the code. I tried replace "End" with "Exit Sub" this only stops the code in Test2 from running, is it will give me an error when it goes back to Test1.
EDIT2:
Test1() is actually four different subs (at this point, more will be added) that all call Test2(). That is why I choose to split it up into so many subs and call them from within the subs.
No, not if you insist on using End. This will essentially have the same effect as clicking the "Stop" button in the developer window. You should (most likely) not be using End. I cannot tell you what you should be using, since I do not know what you are trying to achieve.
Update:
Based on your code, I don't see any reason for Test3() to be nested within Test2(), since it runs either the random code or Test3() (never both). Is there anything preventing you from splitting all the different cases into different subs, and then doing the If statement in the main sub?
Sub Main()
If Variable = 0 Then
'Random code from before Test2()
'Random code from Test2()
'Random code from after Test2()
ElseIf Variable = 1 Then
Call Test3()
Else
MsgBox "Variable must be 0 or 1!"
End Sub
You somehow need to tell Test1 that it needs to stop. One approach to this problem is to change your subs to functions and return a value indicating status. Something like this would work:
Function Test1() As Integer
Dim i As Integer
'Random code
i = Test2(Variable)
If i = 1 Then Exit Function
'Random code
End Function
Function Test2(ByVal Variable As Double) As Integer
Test2 = 0
If Variable = 0 Then
'Random code
End If
If Variable = 1 Then
Call Test3
Test2 = 1
Exit Function
End If
End Function
Function Test3() As Integer
'Random code
End Function
End closes anything and kills all the variables and objects that you have.
This is probably the worst way to end any sub and most probably you do not need it.
What's the deference between "end" and "exit sub" in VBA?
https://msdn.microsoft.com/VBA/Language-Reference-VBA/articles/end-statement

VBA Type Mismatch when application is started

I'm having some trouble with a display object that I use to trigger a sub. The results of the display object are either true or false, and I use the _Change method. The code is quite simple.
Private Sub clamshellLblRequest_Change()
If Not tagDisplay Is Nothing Then
GoTo execute
Else
Set tagDisplay = LoadedDisplays
GoTo execute
End If
execute:
If clamshellLblRequest.Value = 1 Then
LogDiagnosticsMessage "Requesting clamshell label information"
Call labels.clamshell
End If
End Sub
When I first start the application, I get a "type mismatch" error (13) specific to this value. I have several other display objects that I use the same way with the same datatype but don't seem to have this problem. What else could be causing this?
Update:
I have a module I use standard timers with that include the following.
Public Sub tenthSec()
'Create a program delay, DateTime Timer resolution in MSWindows is 0.01. Needed for tag updates.
t = Timer
While Timer - t < 0.1
Wend
End Sub
When I execute call timers.tenthSec just before evaluating the value of the object, it doesn't seem to throw the type mismatch.
...
execute:
Call timers.tenthSec
If clamshellLblRequest.Value = 1 Then
LogDiagnosticsMessage "Requesting clamshell label information"
Call labels.clamshell
End If
End Sub
I wouldn't call this a solution, perhaps a band-aid. Any thoughts?
Agree with #Masoud about the wait. You could also use DoEvents inside of a loop, which allows other things to keep calculating, etc. Also, you shouldn't need the execute: and goto with the code you have, you should be able to just do something like this (note the change of Not Is Nothing to Is Nothing):
Private Sub clamshellLblRequest_Change()
If tagDisplay Is Nothing Then
Set tagDisplay = LoadedDisplays
End If
Application.Wait(Now + #0:00:01#)
' or
For i = 1 to 1000
DoEvents
Next i
If clamshellLblRequest.Value = 1 Then
LogDiagnosticsMessage "Requesting clamshell label information"
Call labels.clamshell
End If
End Sub

Exiting procedure that has called a different procedure VBA Excel

I have a procedure that does some error checking for me and is called from a different procedure. What I want to be able to do is that if incorrect data has been entered and the error checking procedure finds this then I want to stop the procedure that called the error checking procedure. i.e. if error checking procedure is
sub errorCheck
and main procedure is
sub main
and main calls error checking. when error is found I want sub errorCheck to stop main. I have tried to use exit sub but this exits only the errorCheck sub not main
and help would be great thanks
Make it a function that returns a Boolean. Check if the value is False in the calling procedure main and then do an Exit Sub in the main procedure.
A bit nastier way to do it: Just type End instead of Exit Sub. This does however stop the execution of the code completely.
Something like this:
Function errorcheck() As Boolean
' in this case it is always false of course
errorcheck = False
End Function
Sub main()
If Not errorcheck Then
Exit Sub
End If
End Sub
You can use global object Err to complete this task.
Look at the example below:
Sub main()
'(...)
On Error Resume Next
Call errorChecking
If VBA.Err.Number = 999 Then
Exit Sub
End If
On Error GoTo 0
'(...)
End Sub
Sub errorChecking()
If Error Then
Call VBA.Err.Raise(999, "errorChecking", "Error found")
Exit Sub
End If
End Sub
Before we invoke function errorChecking we instruct VBA that it shouldn't stop if any error occurs - it should just ignore it and go to the next line of code instead.
Inside errorChecking function there is a conditional statement that checks if error occurred.
In case the error occurred, this function raise a new error with the number defined by you (999 in my example, you can come up with your own number).
Back in the Main function we check if the current number of VBA.Err object is 999. If it is, it means the error was raised by the function errorChecking and we can leave the Main sub.
Here is a simple example based on Tom's answer:
Sub MAIN()
Dim rng As Range, CellIsNogood As Boolean
Set rng = Application.InputBox(Prompt:="Enter range", Type:=8)
Call ErrorCheck(rng, CellIsNogood)
If CellIsNogood Then
MsgBox "error in range"
End If
End Sub
Sub ErrorCheck(r As Range, b As Boolean)
Dim rr As Range
b = False
For Each rr In r
If IsError(rr.Value) Then
b = True
End If
Next rr
End Sub
After seeing what Tom and had said I did a bit of research and got this working. Below is the code that I used. Thanks for the other answers :)
Private Function errorCheckingBox(box1, message) As Boolean
If Len(box1.value) = 0 Then
MsgBox message, vbExclamation, "Invalid Selection" ' displays a messgae box
box1.SetFocus
errorCheckingBox = True
End If
End Function

Exit main sub procedure if called sub is false

I have a 'protection' sub procedure Sub unprot_manually() which can been seen below. I have another sub procedure which could be refereed to as the main procedure of the workbook. I would like to call this protection procedure prior to allowing the user to run the main procedure. With my current code below, the user is able to run the main procedure regardless of entering the correct password. Do I need to create a 'protection' function, define as Boolean, and then pass as a parameter to the main sub?
Sub unprot_manually()
Dim password_input
Dim Pass As String
Application.ScreenUpdating = False
Pass = "xxxxxx"
password_input = Application.InputBox("Password", "Awaiting User Input..")
If password_input = Pass Then
Call Unprot
'Else
'MsgBox ("Incorrect, Good Bye")
'MsgBox ("Incorrect")
End If
Application.ScreenUpdating = True
End Sub
change it from a Sub to a Function, and then check the return value.
e.g. in your main procedure,
if unprot_manually then
rest of program
else
msgbox "Incorrect Passowrd"
end if
your other section would then become:
Function unprot_manually() as Boolean
'set to fail condition until we get a success status
unprot_manually=False
...
If password_input = Pass Then
Call Unprot
'passed, so set success condition
unpot_manually=True
End If
...
End Function
Creating a UDF to do a simple string comparison is a bit OTT. You don't even need a separate procedure for this, just put the If block in your main procedure
Sub Unprot()
If Application.InputBox("Password", "Awaiting User Input..") = "xxxxxx" Then
' Rest of code here
Else
MsgBox "Incorrect Password!"
End If
End Sub
Even better than this, just set the worksheet protection with the UserInterfaceOnly option set to true, then the user can't make any changes on the front end, but your code can still run without obstruction.
UPDATE: (In response to comment)
Just use a variable and check the input:
Sub Unprot()
Dim tempStr As String
tempStr = InputBox("Password", "Awaiting User Input..") ' Assign value via input
If tempStr = vbNullString Then Exit Sub 'If no input, exit sub
If tempStr = "xxxxxx" Then
'Rest of Code
Else
MsgBox "Incorrect Password!"
End If
End Sub