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
Related
EDIT: I figured it out myself. I feel pretty silly, but replacing "Exit Sub" with "End" works perfectly.
Background: I have a Sub that uses the "Call" function to run multiple subs within one Sub (see Code #1 below).
Option Explicit
Sub MIUL_Run_All()
Dim StartTime As Double
Dim SecondsElapsed As String
'Remember time when macro starts
StartTime = Timer
Call OptimizeCode_Begin
Call Format_MIUL
Call Custom_Sort_MIUL
Call Insert_Process_List
Call Format_Process_List
Call OptimizeCode_End
'Determine how many seconds code took to run
SecondsElapsed = Format((Timer - StartTime) / 86400, "ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
My first code that is called out, "Format_MIUL", prompts the user to save the file, using the following line of code (see Code #2 below). This code works, but the problem is that if the user presses the "Cancel" button, the rest of the code called out in the main sub (Code #1 above) will continue to run. I want ALL code to stop if the user presses the cancel button. I just can't seem to figure out how to do that.
'Save file as .xlsm
MsgBox " Save as Excel Workbook (.xlsx)!"
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(, 51)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
Any help is greatly appreciated.
The Call keyword has been obsolete for 20 years, you can remove it.
The End keyword will effectively end execution, but it's pretty much a big red "self-destruct" button that you effectively never need to use, given properly structured code.
Looks like Format_MIUL is a Sub procedure. Make it a Function and return a Boolean value that tells the caller whether it's ok to proceed, or if the rest of the operations should be cancelled:
Private Function Format_MUIL() As Boolean
'...
'Save file as .xlsm
MsgBox " Save as Excel Workbook (.xlsx)!"
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(, 51)
On Error GoTo 0
'return False if userResponse isn't a filename, True otherwise:
Format_MUIL = Not VarType(userResponse) = vbBoolean
End Function
And now instead of this:
Call Format_MIUL
The caller can do this:
If Not Format_MIUL Then Exit Sub
And there you go, graceful exit without any self-destruct buttons pressed.
I've written a macro which is time consuming (it works for a few hours); that's why I want to add two things to my UserForm, to manually stopping the macro.
First button starts the macro. Let's assume that that code of this macro looks like:
For i = 1 to 10000
DoEvents
If isCancelled Then Exit Sub
Next i
I was thinking about adding an additional "Stop" button, which changes isCancelled from False to True, but the button is locked and can't be clicked during macro execution. Is there any way to enable this button? Or maybe there is a better way to manually stop the macro?
Conceptually, yes this is possible and can be illustrated with a simple example. This is essentially the type of code you alluded to.
Assume your UserForm has two buttons, which start (or resume) and stop the procedure respectively.
Option Explicit
Public isCancelled As Boolean
Public iVal As Long
Private Sub CommandButton1_Click()
Dim i As Long
If iVal = 0 Then iVal = 1 'Allows the user to resume if it's been "stopped"
isCancelled = False
For i = iVal To 100000
iVal = i
If i Mod 1000 = 1 Then
Debug.Print i
End If
If isCancelled Then
GoTo EarlyExit
Else
DoEvents
End If
Next
EarlyExit:
End Sub
Private Sub CommandButton2_Click()
isCancelled = True
End Sub
Of course, implementing the "continuation" option which I did here is a neat little trick, but it may be increasingly complicated depending on the complexity of your procedure, it's dependencies, etc. and if your form is displayed vbModeless you'll need to ensure the user doesn't alter the environment in such a manner as to introduce a runtime error, etc.
You may also look to optimize your procedure if runtime is several hours.
you need to use DoEvents in the loop to catch user responds.
see this answer, which might help you as well.
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
I have an XLA I'm use to make calculations and I'd like to create variables in the Name Manager to use in those calculations. I want to check to see if those named ranged already exist and if not let the user assign values to them. I have a Sub() that I'm using to set the Name Manager -example below- :
Public Sub SetNames()
On Error Resume Next
IsRangeName = CheckName("test")
If IsRangeName = Empty Then
Application.ThisWorkbook.Names.Add Name:="test", RefersTo:=0
End If
End Sub
If I go into the "Macro" menu and run the SetNames routine it works and sets test = 0 in the Name Manager.
However, what I want to do is run this through a Function and allow the function to use the variables in the Name Manager if they exist, if they don't exist then those values get set to an initial value in the Name Manager through the subroutine.
When I try to run the following code the values are never set in the Name Manager:
Sub Function1()
Call SetNames()
-Do Other Things-
End Function
All of the names are declared as global variables.
The intent is to have a user install the add-in and on the first function call using the add-in the Name Manager gets set, either to initialize the names or to allow the user to set the initial value. I don't want the user to go through the Macro ribbon option and execute the subroutine to initialize the Name Manager names.
Any help on this would be appreciated.
This seems to work in my quick testing, but you should be sure it performs in whatever your final use case is. It's a hack around the restrictions on a UDF being able to update the workbook, so it's outside of "normal" usage.
Sub SetNameIfMissing(swb As String)
Dim r As Name, wb As Workbook
Set wb = Workbooks(swb)
On Error Resume Next
Set r = wb.Names("test")
On Error GoTo 0
If r Is Nothing Then
Debug.Print "adding name..."
wb.Names.Add "test", 99
Else
Debug.Print "already added"
End If
End Sub
Function SetIt(v)
Dim wb
wb = Application.Caller.Parent.Parent.Name
'using Evaluate gets around the UDF restriction
Application.Caller.Parent.Evaluate "SetNameIfMissing(""" & wb & """)"
SetIt = "OK" 'or whatever return value is useful...
End Function
Not sure what "CheckName" is in your script - you didn't provide it .. however, I got it to work via:
1) comment out On Error Resume Next - this allows you to see CheckNames failing.
2) Replaced CheckNames with a loop to loop throw the defined names, looking for ours.
3) change your "function" definition from "sub" to "function".
test it, runs fine.
Sets the "test" name if it doesn't exist. Change it manually to another value, run again, doesn't touch it.
Public Sub SetNames()
'On Error Resume Next
For i = 1 To Application.ThisWorkbook.Names.Count
If Application.ThisWorkbook.Names(i).Name = "test" Then
IsRangeName = True
Exit For
End If
Next i
If Not IsRangeName Then
Application.ThisWorkbook.Names.Add Name:="test", RefersTo:=1
End If
End Sub
Function Function1()
Call SetNames
'-Do Other Things-
End Function
i have access 2007 form and i want to test if a particular control (toggle button) has the focus ,
something like :
if gotfocus(mytoggle) then
dosomething
endif
or maybe like :
if me.mytoggle.setfocus = true then
dosomething
endif
I have searched and cannot find this , can someone tell me what is correct top to do this ?
This for the current form:
If (mytoggle Is Me.ActiveControl) Then
This for the current Access.Application:
If (mytoggle Is Screen.ActiveControl) Then
Be careful, if no control has focus, *.ActiveControl may not exist.
Try this code - I've tried to account for .ActiveControl not existing.
Private Function isCurrentControl(thisControl As Control) As Boolean
On Error GoTo err_handler
If Not Me.ActiveControl Is Nothing Then
If (Me.ActiveControl Is thisControl) Then
isCurrentControl = True
Else
isCurrentControl = False
End If
Else
GoTo err_handler
End If
close_function:
On Error GoTo 0
Exit Function
err_handler:
isCurrentControl = False
Resume close_function
End Function
You just need to call the function and set the control as a parameter
''EXAMPLE: isCurrentControl(mytoggle)
Unfortunately, there are situations where the .ActiveControl is temporary non-existing ! When records are scrolled in a form, the procedure Form_Current() gets run. Already at the beginning, there is no focus anymore – the focus is reset to the previous field only after Form_Current() has terminated.