Excel VBA Userform QueryClose: Cancel not working - vba

I've written the code below so that it will check if a process has been completed or not before closing the form. This userform is used as a scoresheet that will make range("A6") green to signify a pass, or range("B6") red to signify a fail as the final step of the sub, before unloading the form.
From what I've checked online so far, it should be working. While debugging, the macro gets all the way to where it says Cancel = True, reads over the line, but the form closes anyway.
Why isn't the cancel registering even when it reads over the line?
Private Sub Userform_queryclose(CloseMode As Integer, Cancel As Integer)
Dim wbScoreCard As Workbook
Dim wsScoreCard As Worksheet
Dim MSG As String
Set wbScoreCard = Workbooks(NameBox.Value)
Set wsScoreCard = wbScoreCard.Worksheets(Format(Date, "MM.dd.yy") & " " & CallType.Caption)
If Err.Number = 0 Then
If wsScoreCard.Range("A6").Interior.Color <> vbGreen Then
If wsScoreCard.Range("B6").Interior.Color <> vbRed Then
Beep
MSG = MsgBox("This scorecard is not complete! If you close it now, this scorecard will not be saved. Continue?", vbYesNo, "Warning - Scorecard Incomplete")
If MSG = vbYes Then
wbScoreCard.Close savechanges:=False
Exit Sub
Else
Cancel = True
Exit Sub
End If
End If
End If
End If
End Sub

Couple of things:
You're not shutting off error handling, so the Err.Number = 0 check has no effect; if there's a runtime error, execution jumps straight out of the procedure anyway.
MSG should be a vbMsgBoxResult, not a String. Your code only works because of implicit type conversions from the underlying Integer value to the String type you're forcing it into.
Unless you didn't post your entire code, Exit Sub is redundant in both branches.
The problem can be reproduced with simpler code:
Private Sub Userform_queryclose(CloseMode As Integer, Cancel As Integer)
Cancel = True
End Sub
The problem is that you made up that signature or somehow typed it up from memory. This is the signature for the QueryClose handler:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Notice the ordering of parameters.
You'll get the expected behavior by setting your CloseMode to True instead of Cancel... but a better fix would be to put the parameters in the correct order.
Event handlers don't really care about parameter names: it's about types and order. Since both parameters are Integer, it's down to ordering: the first Integer parameter is interpreted as the Cancel parameter, and the second is the CloseMode - the form / COM doesn't care how you called them, it's going to read the Cancel value from the first parameter anyway.
You can avoid this problem in the future, by selecting the event from the dropdowns at the top of the code pane:
Make sure the left-hand dropdown says "UserForm", and then select "QueryClose" from the right-hand dropdown:
If there's no handler for it, the VBE will create one properly formed for you.

Related

Number only text box not working on one of two text boxes in a userform

I have two text boxes on a userform that I would like to be numeric only. The first one works fine based on this( Link), however the second one, which I have implemented in exactly the same way as the first is not working, and I don't know why. Any idea why?
The first textbox is call TextBoxMainVal
The second is called perHour
Code:
'If the Main Value box does not recieve a number send a message to make them change it
Private Sub TextBoxMainVal_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBoxMainVal.Value = "" Then
ElseIf Not IsNumeric(TextBoxMainVal.Value) Then
MsgBox "Enter numbers only"
Cancel = True
TextBoxMainVal.Value = vbNullString
End If
End Sub
'I DONT KNOW WHY THIS ONE ISNT WORKING!
Private Sub perHour_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If perHour.Value = "" Then
ElseIf Not IsNumeric(perHour.Value) Then
MsgBox "Enter numbers only"
Cancel = True
perHour.Value = vbNullString
End If
End Sub
I thought there could be a naming error conflict, so I changed the textbox name, but that did not resolve it.
I cant understand why it is not working. What am I overlooking?
For those who are interested why this may happen there is an answer here. The reason, it appears, the textbox exit handler is not occurring is because it is outside of a frame. For the exit handler to work you need to stay inside the frame.

What property will return the caret (or cursor type bar) to the designated textbox in VBA Excel UserForms? [duplicate]

I have a textbox on a userform. If the user fails to enter anything in this textbox, I need to trap that to force an entry. I can do this easily enough, but after notifying the user tht they need to make an entry, I want the focus to return to the textbox. Right now, it doesn't do that. Here is my code:
Private Sub txtAnswer_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13:
If Me.txtAnswer.Value = "" Then
temp = MsgBox("You need to enter an answer!", vbCritical + vbOKOnly, "No Answer Found!")
Me.txtAnswer.SetFocus
Else
recordAnswer
End If
End Select
End Sub
This code works fine in that the message box pops up if the textbox is left blank. After clearing the message box, if I hit enter immediately again, the message box reappears, suggesting that the focus is on the textbox. However, if I try to enter a character (like the number '1' for example) nothing appears in the textbox.
Can anybody suggest how I can get the focus back on this textbox in a way that will allow the user to enter data? Thank you!
Why are you not using an 'ok' button to complete the action?
You should not bother users with messages while they are typing in a form. Do it at the end.
Private Sub OK_Click()
'// Validate form
If txtAnswer.Text = vbNullString Then
MsgBox "You need to enter an answer!", vbExclamation, "No Answer Found!"
txtAnswer.SetFocus
Exit Sub
End If
'// You have reached here so form is correct carry on
recordAnswer
End Sub
If you really want to use the behaviour you asked for then try this:
Private Sub txtAnswer_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13:
If Me.txtAnswer.Value = "" Then
temp = MsgBox("You need to enter an answer!", vbCritical + vbOKOnly, "No Answer Found!")
KeyCode = 0
Else
recordAnswer
End If
End Select
End Sub
The problem is that in your code you are setting focus but the enter key is firing afterwards. You don't need to set focus because the textbox already has the focus you just need to cancel the enter key.
The other answers seem really complicated. I had a similar problem and really wanted a text warning. It seemed easier for me to just make an invisible label on the form that would show up if the input was incorrect. I also made the background of the label red so that the user would notice something was wrong. Doing it this way kept the cursor visible and right where they left off.
Public Function amount(ByRef cont As MSForms.TextBox) As Integer
'makes sure that a number is used
'could change to account for decimals if necessary
Dim i As Long
On Error Resume Next
i = 0
If (cont.Value = "") Then Exit Function
Do While i < 1000000
If (cont.Value = i) Then
UserForm1.Label257.Visible = False
Exit Function
End If
i = i + 1
Loop
UserForm1.Label257.Visible = True
amount = 1
End Function
Public Sub qty_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If amount(UserForm1.qty) = 1 Then
Cancel = True
End If
End Sub
I hope this helps other who run into this problem later on.
Looking at the above code, I assume the i counter is to keep it going? Sorry a bit rusty, been a few years since I've done code.
At any rate, if thats the case you could always run it while i=0, do (or while true).
Sorry, first time posting here, hope that made sense.

xlDialogSaveAs - End ALL code if "cancel" is selected

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.

Advanced customization of InputBox edit control

So I have some basic VBA code:
Sub Test()
' Set error handler
On Error GoTo ErrorHandler
Dim strElevation As String
strElevation = InputBox("Enter elevation difference:", "Create Cross Lines", 0.5)
Exit Sub
ErrorHandler:
Call ReportError("Test")
End Sub
And it looks fine:
Is it possible to extend this so that the edit box will only allow a numeric value to 2 decimal places? Or is it simply too much work?
I know how to format text itself, eg: Format("1234.5678", "#.00"). But can the actual edit control have any customization itself?
You basically have three options here... In order of difficulty:
1. Validate the input
This uses the native InputBox() function as you have in your code sample above. You can return the value into a string variable, then do your validation at that point to make sure the data is formatted the way you want. If it doesn't pass, then display the input box again.
2. Custom VBA form
If you create your own VBA User Form, you can customize the text box to use a specific format, and perform the validation before the form accepts the input and closes. This is probably the most user-friendly approach, but involves a little more code than the first method.
Example:
Create sample VBA form with two input boxes and a command button. Name them txtDiff1, txtDiff2, and cmdOK respectively.
Double-click one of the controls, and add the following code to the code module behind the form:
Option Explicit
Private Sub cmdOK_Click()
MyElevationDifference = txtDiff1 ' (or txtDiff2)
Unload Me
End Sub
Private Sub txtDiff1_AfterUpdate()
Dim dblValue As Double
If IsNumeric(txtDiff1) Then
' Determine rounded amount
dblValue = Round(txtDiff1, 2)
' Automatically round the value
If dblValue <> CDbl(txtDiff1) Then txtDiff1 = dblValue
Else
MsgBox "Please enter a numeric value", vbExclamation
End If
End Sub
Private Sub txtDiff2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim dblValue As Double
If IsNumeric(txtDiff2) Then
' Determine rounded amount
dblValue = Round(txtDiff2, 2)
' Require a max of 2 decimal places
If dblValue <> CDbl(txtDiff2) Then
Cancel = True
MsgBox "Please only use 2 decimal places", vbExclamation
End If
Else
MsgBox "Please enter a numeric value", vbExclamation
' Cancel change
Cancel = True
End If
End Sub
Paste the following into a regular code module. (This is how you can get the input in your main code through the custom form. Essentially the form assigns a value to the global variable, and you reference that after showing the form.)
Option Explicit
Public MyElevationDifference As Double
Public Sub GetElevationDifference()
UserForm1.Show
MsgBox "Elevation difference: " & MyElevationDifference, vbInformation
End Sub
Now when you run GetElevationDifference(), you will see a couple different approaches demonstrated on the user form. The first text box automatically rounds the input, while the second text box does not allow the user to continue unless they correct the input to use two decimal places or less.
Of course you will want to add some error handling and make the form look nice, but this gives you a simple example of how to use a VBA form to get user input. They involve a little more code, but obviously provide a huge level of additional flexibility over the simple InputBox() function.
3. Windows API calls
Just for completeness, there are ways to use Windows API calls to actually affect the controls on an input box, but this would end up being far more complex than the first two approaches, and I would not recommend it for something like this.
this is how you can restrict to input box to allow only numeric values:
strElevation = Application.InputBox(prompt:="Enter elevation difference:", Title:="Create Cross Lines", Default:=0.5, Type:=1)
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/application-inputbox-method-excel
To validate the lenght, you can use the following code:
Do
strElevation = Application.InputBox(prompt:="Enter elevation difference:", Title:="Create Cross Lines", Default:=0.5, Type:=1)
If Len(strElevation) > 2 Then MsgBox "You typed in too many characters... 2 maximum!"
Loop While Len(strElevation) > 2
Private Sub TextBox1_AfterUpdate()
If InStr(1, Me.TextBox1.Value, ".") > 0 Then
If Len(Mid(Me.TextBox1.Value, _
InStr(1, Me.TextBox1.Value, "."), _
Len(Me.TextBox1.Value) - InStr(1, Me.TextBox1.Value, "."))) > 2 Then
Me.TextBox1.SetFocus
MsgBox "cannot have more than 2 decimal places"
End If
End If
End Sub
Apply to your situation but this gets you there
Sub Test()
' Set error handler
On Error GoTo ErrorHandler
Dim strElevation As String
strElevation = InputBox("Enter elevation difference:", "Create Cross Lines", 0.5)
If InStr(1, strElevation, ".") > 0 Then
If Len(Mid(strElevation, InStr(1, strElevation, "."), Len(strElevation) - InStr(1, strElevation, "."))) > 2 Then
MsgBox "cannot have more than 2 decimal places"
End If
End If
Exit Sub
ErrorHandler:
Call ReportError("Test")
End Subc

Data Validation and Worksheet Change Event

I use a VBA macro to query a database and build a list of available projects when a workbook is opened using the workbook activate event. I have project numbers and project names that are combined into two separate data validation lists and applied to two cells. The worksheet change event tests for changes in these cells, splits their data validation lists into arrays, and chooses the corresponding project information from the other array. For instance, if I pick a project number, the worksheet change event finds the project number's position in the project number array, and then picks the project's name from the name array based on position.
This works perfectly whenever a value is selected from the drop down, but I run into problems when values outside the list are entered. For instance, if I enter a blank cell I may get the data validation error or I may get a type mismatch when I use match to find the entered value in the array. I have an error handler to handle the type mismatch, but I would like the data validation error to trigger every time instead. Another problem is that Events will sometimes be disabled. This is much more serious because users will not have a way to turn these back on.
On top of this, I cannot figure out where or how this is happening. I can't replicate how the Events are disabled using breaks because duplicating the steps that lead to the events being disabled with breaks in place only leads to my error handler. However, when breaks aren't applied, the error handler will sometimes fail to trigger and the events will be disabled. Since I'm disabling events just before I parse arrays, I'm thinking the worksheet change fails at the Loc=Application.Match(Target.Text, NumArr, 0) - 1 line, but I can't figure out why no error would be triggered. At the very least, I should get a message with the error number and description, and events should be re-enabled.
Can anyone advise on the interaction between worksheet change and data validation? What is the call order here? Any other advice? Anything I'm missing?
ETA: I've Googled this, but I haven't found anything that helps. Everything that comes up is about working the data validation into worksheet change, nothing about the interaction or call order.
ETA #2: After trying the experiment in the answer below (Thanks Gary's Student), this gets a little more odd. If I choose "Retry" and choose the old, default value, I get the old value three times. If I hit delete, I get a space in the message box, but only one message box. Then the cell is left blank. I can put DV into a loop by clicking "Retry" and accepting the space. The DV error will come up until I click cancel. Then I will get a series of empty text message boxes, one for each time I retried the empty cell. If I start off with a listed value, clear the cell with backspace, click "Retry," and try to select another value, the worksheet change event fails at Intersect 3 times. I think the answer below sheds more light on what is going on, but it does bring up more questions also.
Here is the code I have:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NumArr() As String
Dim ProjArr() As String
Dim Loc As Integer
On Error GoTo ErrHandler:
If Target.Address = "$E$4" Then
'Disable events to prevent worksheet change trigger on cell upates
Application.EnableEvents = False
'Parse validation lists to arrays
NumArr = Split(Target.Validation.Formula1, ",")
ProjArr = Split(Target.Offset(1, 0).Validation.Formula1, ",")
'Change error handler
On Error GoTo SpaceHandler:
'Determine project number location in array
Loc = Application.Match(Target.Text, NumArr, 0) - 1
'Change error handler
On Error GoTo ErrHandler:
'Change cell value to corresponding project name based on array location
Target.Offset(1, 0) = ProjArr(Loc)
'Unlock cells to prepare for editing, reset any previously imported codes
Range("C8:G32").Locked = False
'Run revenue code import
RevenueCodeCollector.ImportRevenueCodes
'Re-enable events
Application.EnableEvents = True
End If
If Target.Address = "$E$5" Then
Application.EnableEvents = False
NumArr = Split(Target.Validation.Formula1, ",")
ProjArr = Split(Target.Offset(-1, 0).Validation.Formula1, ",")
Loc = Application.Match(Target.Text, NumArr, 0) - 1
Target.Offset(-1, 0) = ProjArr(Loc)
Range("C8:G32").Locked = False
RevenueCodeCollector.ImportRevenueCodes
Application.EnableEvents = True
End If
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Application.EnableEvents = True
Exit Sub
SpaceHandler:
MsgBox "Pick a project from the dropdown.", vbOKOnly, "Error"
Application.EnableEvents = True
End Sub
You have a very open-ended question...........not having the time to do a full whitepaper, here is a simple experiment. I use the Event code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A1 As Range, rINT As Range
Set A1 = Range("A1")
Set rINT = Intersect(A1, Target)
If rINT Is Nothing Then Exit Sub
MsgBox A1.Value
End Sub
and in A1, I setup DV as follows:
If I use the drop-down, I get the value entered and I also get the MsgBox. However, if I click on the cell and type some junk what happens is:
the DV alert occurs and I touch the CANCEL Button
I get 2 MsgBox occurrences, each with the original contents rather than the attempted junk !!
I have absolutely no idea why the event is raised since the cell is not actually changed, let alone why the Event is raised twice !! It is almost as if
the event is raised on junk entry, but the DV alarm has precedence, the DV reverse the entry and another event is raised, and finally both events get processed.
Hopefully a person smarter than me will chime in.
With ref to the query, Workaround for the DV and change event is managed.
Public strRange As String
Public bCheck As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If bCheck Then Exit Sub
MsgBox "Correct Entry!"
strRange = Target.Address
bCheck = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> strRange Then bCheck = False
End Sub
http://forum.chandoo.org/threads/multiple-worksheet-change-event-with-data-validation.32750