This time I was making option boxes so I put in the code with the speech marks around the answer then I tried using it but it just wouldn't work. The code I put in was:
Private Sub OptionButton1_Click()
If OptionButton1.Value = "Stores all the components" Then
MsgBox "That is correct. Well done!"
SlideShowWindows(1).View.Next
Else
MsgBox "Sorry, that is not right. Try again"
End If
End Sub
Please can someone help me?
I think you are trying this
If OptionButton1.Caption = "Stores all the components"
or This
If OptionButton1.Value = True Then
An optionButton in VBA has a Value of 0 (unchecked) or -1 (checked). If you are looking for what the optionbutton says, I believe you want .Caption instead of .Value
EDIT:
After looking at your code again, I see a fundamental flaw. You are assigning this to just option click, so if the first button does not have the correct value, then nothing will happen. I think what you need is a subroutine like this
Private Sub checkAnswer (answer as string)
dim expecTedAnswer as string
expectedAnswer = "The correct answer"
if answer = expectedanswer then
msgbox "Correct"
else
msgbox "Incorrect"
end if
End sub
Then in the option click, just call the Sub
CheckAnswer(OptionButton1.Caption)
Note that this is extremely ugly (you would want to create an easily usable calling method and way of setting the correctAnswer), but it should give you something to go on.
A little prettier perhaps ...
Each OptionButton click event calls CheckAnswer:
Private Sub OptionButton1_Click()
If CheckAnswer(Me.OptionButton1, "Correct answer") Then
MsgBox "Good user. GOOD!"
Else
MsgBox "Bad user! BAD! Go stand in the corner."
End If
End Sub
Private Sub OptionButton2_Click()
If CheckAnswer(Me.OptionButton2, "Correct answer") Then
MsgBox "Good user. GOOD!"
Else
MsgBox "Bad user! BAD! Go stand in the corner."
End If
End Sub
Function CheckAnswer(oCtl As Object, sCorrectAnswer As String) As Boolean
If UCase(oCtl.Caption) = UCase(sCorrectAnswer) Then
CheckAnswer = True
Else
CheckAnswer = False
End If
End Function
Related
I created a Projects database which includes a form with fields for staff to complete on startup of a project.
The first field, 'ClientCode' is a compulsory dropdown list (Combobox) of Clients.
To avoid accidental changes to this field, I added 'On Change' code to display a warning message:
Private Sub ComboClientCode_Change()
If MsgBox("Are you sure you want to change the client?", vbQuestion + vbYesNo) = vbNo Then
DoCmd.RunCommand acCmdUndo
Else
Exit Sub
End If
End Sub
It works, however I don't want it to run when someone starts a new record i.e. selects the client for the first time.
How do I make this message only show if it is a change to the original entry?
I tried moving it to 'AfterUpdate' but it does the same thing.
Right, I haven't tested any of the code below so let me know if it works for you. I propose 2 different solutions, and depending on if the logic works, the solution will work.
Solution 1:
Using the change event, you check the combobox value, and if it is blank then run the code. My concern with this is that when the event handler fires there will only be a value in there because the user would have changed the value to call the event handler. Nonetheless, the code would look like something below.
Private Sub ComboClientCode_Change()
If Me.ComboClientCode.Value <> "" Then
If MsgBox("Are you sure you want to change the client?", vbQuestion + vbYesNo) = vbNo Then
DoCmd.RunCommand acCmdUndo
Else
Exit Sub
End If
End If
End Sub
Solution 2:
With this solution the logic seems a bit more sound than the above method. What will happen is you will set the default value of the combobox using the UserForm_Initialize() event handler. Then, when your user selects from the dropdown list it will set the value to that variable, and will prevent the unnecessary pop up. See below code. Your userform module should look like the below.
Option Explicit
Dim sClientCode As String
Private Sub UserForm_Initialize()
sClientCode = Me.ComboClientCode.Value
End Sub
Private Sub ComboClientCode_Change()
If sClientCode <> "" Then
If MsgBox("Are you sure you want to change the client?", vbQuestion + vbYesNo) = vbNo Then
'set the value now
sClientCode = Me.ComboClientCode.Value
DoCmd.RunCommand acCmdUndo
Else
Exit Sub
End If
End If
End Sub
You could change one of the "irrelevant" properties of the combobox the first time it gets changed.
Private Sub ComboClientCode_Change()
If ComboClientCode.ColumnHeads = False Then
ComboClientCode.ColumnHeads = True
Else
If MsgBox("Are you sure you want to change the client?", vbQuestion + vbYesNo) = vbNo Then
'DoCmd.RunCommand acCmdUndo
Debug.Print "DoCmd.RunCommand acCmdUndo"
Else
Exit Sub
End If
End If
End Sub
Should work for this type:
Listed properties of above selected type:
You can run this to make the existing one change if it has a value:
Sub Switch()
If ComboClientCode.Value <> "" Then
ComboClientCode.ColumnHeads = True
Else
ComboClientCode.ColumnHeads = False
End If
End Sub
I hope this is not that stupid, but I really did not find a post that was working for me.
Situation: I want someone to put a date into a textbox in a Userform.
ErrorHandler: I wanted to have a very simple solution if the user doesn't enter the right format. (EB_Start.Activate and EB_Start.SetFocus are NOT working at all)
For this I got:
Private Sub EB_Ende_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo Error_Handler
Me.EB_Ende = CDate(Me.EB_Ende)
Error_Handler:
EB_Start.Activate
EB_Start.SetFocus
MsgBox ("Please enter a valid date"), , "Datum"
End Sub
Problem:
My Question is now, how do I redirect the focus on the textbox(EB_Ende)
The current reaction is, after the user presses Enter after the MsgBox showed up, It continued to the next textbox, but I want the user to be forced to reenter a valid date in the textbox.
If someone could help me out with this, or redirect me to a Post or link that will answer my question I would really appreciate it.
Best regards,
Lutscha
This is the whole UserForm
There are a couple of issues with your code (e.g. not exiting before the error handler, and do you want to use Cancel=msoTrue to cancel the text entry to EB_Ende when you get an error?) so you could try this:
Private Sub EB_Ende_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo Error_Handler
Me.EB_Ende = CDate(Me.EB_Ende)
Exit Sub
Error_Handler:
EB_Start.SetFocus
MsgBox ("Please enter a valid date"), , "Datum"
End Sub
Or, you could skip the error-hander entirely:
Private Sub EB_Ende_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.EB_Ende) Then
Me.EB_Ende = CDate(Me.EB_Ende)
Else
Cancel = msoTrue
EB_Start.SetFocus
MsgBox ("Please enter a valid date"), , "Datum"
End If
End Sub
Setting focus in BeforeUpdate event won't work - it is too soon. It is fired before focus is moved to the next control. Better approach is to handle Exit event and cancel it when needed:
Private Sub EB_Ende_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo Error_Handler
EB_Ende = CDate(EB_Ende)
Exit Sub '<-- exit sub when there is no error
Error_Handler:
Cancel = True
MsgBox ("Please enter a valid date"), , "Datum"
End Sub
The funny thing is, you used the answer as a tag on your question:
Me.EB_Ende.SetFocus
Here is more information on SetFocus.
Something else that might help... you can change the default order that objects are "tabbed" through. (ie., what cell should get focus after you press enter or tab in the current control:
worked perfect
Private Sub txtSalary_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsNumeric(txtSalary) Then
MsgBox "Please, only numbers!", vbRetryCancel
Cancel = True
txtSalary = ""
End If
If IsNumeric(txtSalary) Then
txtSalary = Format(txtSalary, "$#,##0.00")
End If
End Sub
Hi I'm trying to make it so that excel will look if two specific sheets are protected on closure and then if they are not I want a message box to come up warning of this. Currently i've got this far with VBA.
Sub Worksheet_BeforeClose(Cancel As Boolean)
If Sheets("Dashboard Page").ProtectContents = True And Sheets("Tracker Sheet").ProtectContents = True Then
MsgBox "Protected"
ElseIf
MsgBox("Workbook is not protected please protect before closing", _
vbQuestion + vbOKOnly) = vbOKOnly Then
Cancel = True
End If
End If
End Sub
if anyone could help out that would be great.
Thanks
Edit: I'm now having issues with changing this to just an OK button that cancels the close. changes are above. It will just close if the OK button is clicked
The problem is you can not open a sub inside another one, but you can call it.
Sub ProtectMsg_BeforeClose()
If Sheets("Dashboard Page").ProtectContents = True And Sheets("Tracker Sheet").ProtectContents = True Then
MsgBox "Protected"
Else
Workbook_BeforeClose
End If
End Sub
Sub Workbook_BeforeClose()
If MsgBox("Workbook is not protected please protect before closing", _
vbQuestion + vbYesNo) = vbNo Then
Cancel = True
End If
End Sub
Try if it helps you.
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.
Say I have a button embedded into my spreadsheet that launches some VBA function.
Private Sub CommandButton1_Click()
SomeVBASub
End Sub
Private Sub SomeVBASub
DoStuff
DoAnotherStuff
AndFinallyDothis
End Sub
I'd like to have an opportunity to have some sort of a "cancel" button that would stop SomeVBASub execution at an arbitrary moment, and I'm not into involving Ctrl+Break here, 'cause I'd like to do it silently.
I guess this should be quite common issue, any ideas?
Thanks.
Add another button called "CancelButton" that sets a flag, and then check for that flag.
If you have long loops in the "stuff" then check for it there too and exit if it's set. Use DoEvents inside long loops to ensure that the UI works.
Bool Cancel
Private Sub CancelButton_OnClick()
Cancel=True
End Sub
...
Private Sub SomeVBASub
Cancel=False
DoStuff
If Cancel Then Exit Sub
DoAnotherStuff
If Cancel Then Exit Sub
AndFinallyDothis
End Sub
How about Application.EnableCancelKey - Use the Esc button
On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler
MsgBox "This may take a long time: press ESC to cancel"
For x = 1 To 1000000 ' Do something 1,000,000 times (long!)
' do something here
Next x
handleCancel:
If Err = 18 Then
MsgBox "You cancelled"
End If
Snippet from http://msdn.microsoft.com/en-us/library/aa214566(office.11).aspx
Or, if you want to avoid the use of a global variable you could use the rarely used .Tag property of the userform:
Private Sub CommandButton1_Click()
Me.CommandButton1.Enabled = False 'Disabling button so user cannot push it
'multiple times
Me.CommandButton1.caption = "Wait..." 'Jamie's suggestion
Me.Tag = "Cancel"
End Sub
Private Sub SomeVBASub
If LCase(UserForm1.Tag) = "cancel" Then
GoTo StopProcess
Else
'DoStuff
End If
Exit Sub
StopProcess:
'Here you can do some steps to be able to cancel process adequately
'i.e. setting collections to "Nothing" deleting some files...
End Sub
what jamietre said, but
Private Sub SomeVBASub
Cancel=False
DoStuff
If not Cancel Then DoAnotherStuff
If not Cancel Then AndFinallyDothis
End Sub
I do this a lot. A lot. :-)
I have got used to using "DoEvents" more often, but still tend to set things running without really double checking a sure stop method.
Then, today, having done it again, I thought, "Well just wait for the end in 3 hours", and started paddling around in the ribbon. Earlier, I had noticed in the "View" section of the Ribbon a "Macros" pull down, and thought I have a look to see if I could see my interminable Macro running....
I now realise you can also get this up using Alt-F8.
Then I thought, well what if I "Step into" a different Macro, would that rescue me? It did :-)
It also works if you step into your running Macro (but you still lose where you're upto), unless you are a very lazy programmer like me and declare lots of "Global" variables, in which case the Global data is retained :-)
K
~ For those using custom input box
Private Sub CommandButton1_Click()
DoCmd.Close acForm, Me.Name
End
End Sub
This is an old post, but given the title of this question, the END option should be described in more detail. This can be used to stop ALL PROCEDURES (not just the subroutine running). It can also be used within a function to stop other Subroutines (which I find useful for some add-ins I work with).
As Microsoft states:
Terminates execution immediately. Never required by itself but may be placed anywhere in a procedure to end code execution, close files opened with the Open statement, and to clear variables*. I noticed that the END method is not described in much detail. This can be used to stop ALL PROCEDURES (not just the subroutine running).
Here is an illustrative example:
Sub RunSomeMacros()
Call FirstPart
Call SecondPart
'the below code will not be executed if user clicks yes during SecondPart.
Call ThirdPart
MsgBox "All of the macros have been run."
End Sub
Private Sub FirstPart()
MsgBox "This is the first macro"
End Sub
Private Sub SecondPart()
Dim answer As Long
answer = MsgBox("Do you want to stop the macros?", vbYesNo)
If answer = vbYes Then
'Stops All macros!
End
End If
MsgBox "You clicked ""NO"" so the macros are still rolling..."
End Sub
Private Sub ThirdPart()
MsgBox "Final Macro was run."
End Sub