Pop up requiring a specific answer - excel

I'm trying to setup something to have a little fun with my co-workers where when they click a button in Excel it will force them to answer a bunch of math problems before unlocking their system. If they get it wrong I want it to play a funny sound.
That said I'm trying to figure out the best way to handle this and I'm not finding a lot online that does what I'm looking for.
What I have so far isn't working. I keep getting the following error:
"Expected sub function or property"
What I have so far is pretty basic, any help would be greatly appreciated though.
Sub Button1_Click()
Dim ws As Worksheet
Dim a As String
Dim b As String
Dim c As String
Dim URL As String
'Lockout Functions
'Cancel = True
'Check for Muted Sound, Unmute
'First Question
a = Application.InputBox("What is 1+1?")
If a = "2" Then 'continue
Else goto a
Application.Speech.Speak "Are you even trying?"
MsgBox "Hi, you got that answer wrong"
End If
'Second Question
b = Application.InputBox("Finish this Sequence 1123_813__")
If b = "1123581321" Then 'Continue
Else goto b
Application.Speech.Speak "It's the Fibonacci duh!"
MsgBox "Hi, you got that answer wrong"
End If
'Third Question
c = Application.InputBox("What are the next three numbers 1, 4, 9, 16, ?")
If c = "1,4,9,16,25,36,49" Then 'continue
Else goto c
Application.Speech.Speak "Terrible!"
MsgBox "Hi, you got that answer wrong"
End If
'Unlock/Return Control
'Cancel = False
End Sub

You do not need a, b and c into the ELSE
Sub Button1_Click()
Dim ws As Worksheet
Dim a As String
Dim b As String
Dim c As String
Dim URL As String
'Lockout Functions
'Cancel = True
'Check for Muted Sound, Unmute
'First Question
a = Application.InputBox("What is 1+1?")
If a = "2" Then 'continue
Else
Application.Speech.Speak "Are you even trying?"
MsgBox "Hi, you got that answer wrong"
End If
'Second Question
b = Application.InputBox("Finish this Sequence 1123_813__")
If b = "1123581321" Then 'Continue
Else
Application.Speech.Speak "It's the Fibonacci duh!"
MsgBox "Hi, you got that answer wrong"
End If
'Third Question
c = Application.InputBox("What are the next three numbers 1, 4, 9, 16, ?")
If c = "1,4,9,16,25,36,49" Then 'continue
Else
Application.Speech.Speak "Terrible!"
MsgBox "Hi, you got that answer wrong"
End If
'Unlock/Return Control
'Cancel = False
End Sub

Related

GoTo is not defined - in VBA

When I on the step F8 click. then say it Goto is not defined. I try to make a inputbox with a messagebox that me the answer give. And I try also to make code when the values not correct is. See, you where I make a mistake in my VBA code:
Sub TwoNumbersinputbox()
Dim bytAnswer1 As String
Dim bytAntwer2 As String
Dim Range As Byte
Dim strNumber1 As String
Dim strNumber2 As String
[C3] = "Number1"
[C4] = "Number2"
Start1:
strNumber1 = InputBox("Give number one?", "Invoer", 5, 567, 567)
If IsNumeric(strNumber1) Then
MsgBox "This must be Number1", vbCritical, _
"Number1 input"
GoTo strNumber1
Else: [B2] = strNumber1
End If
If Not IsNumeric(strNumber1) Then
MsgBox "there is error.", vbCritical, "Number2 input"
bytAnwer1 = MsgBox("Start Again?", vbYesNo)
If bytAnwer1 = vbYes Then GoTo Start
End If
Start2:
strGetal2 = InputBox("Give Number2?", "Input", 5, 567, 567)
If IsNumeric(strNumber2) Then
MsgBox "This must be Number2 ", vbCritical, _
"Number2 input"
GoTo strNumber2
Else: [B3] = strNumber2
End If
If Not IsNumeric(strGetal2) Then
MsgBox "Is there an error.", vbCritical, "Number2 input"
bytAnswer2 = MsgBox("Start Again?", vbYesNo)
If bytAnswer2 = vbYes Then GoTo Start
End If
End Sub
First thing first - never use GOTO. Only in error handling (On Error statement (VBA)).
Second - if you need to use it, a mark is needed. E.g., if it is GoTo somewhere, then in the code it should be defined like this - somewhere:.
Sub DontUseGoTo()
Dim i As Long
i = 0
somewhere:
i = i + 1
Debug.Print i
If i < 10 Then
GoTo somewhere
End If
End Sub

How to lock msgbox pop ups in VBA

I'm setting up an office prank for April Fools that when a question is answered wrong a pop up (Msgbox) will pop up and I want it so it doesn't go away. The idea is their screen would get clogged with these msgboxes till they get the questions right. I'm not sure how to accomplish this though. Any help would be greatly appreciated!
Here is the current code:
Sub Button1_Click()
Dim ws As Worksheet
Dim a As String
Dim b As String
Dim c As String
Dim Ret As Variant
'Lockout Functions
'Cancel = True
'Hal2001 Takes Over
Set ws = ThisWorkbook.Sheets("Hal2001")
Sheets("Hal2001").Visible = True
Sheets("Hal2001").Select
Ret = MsgBox("Would you like to play a game?", vbYesNo)
Application.Speech.Speak "I'm sorry I cannot let you do that, Would you like to play a game?"
If Ret = vbNo Then
Application.Speech.Speak "Well I want to play a game, so we are going to play one"
Else
Application.Speech.Speak "Then Lets Begin"
End If
'First Question
a = Application.InputBox("The Declaration of Independence was signed on what day?")
If a = "July 2nd 1776" Then 'continue
Else
Do While a = Application.InputBox("The declaration of independence was signed on what day?") < 100
Application.Speech.Speak "Are you even trying?"
MsgBox "You really don't know when the Declaration of Independence was signed??"
Loop
End If
'Second Question
b = Application.InputBox("Finish this Sequence 1123_813__")
If b = "1123581321" Then 'Continue
Else
Do While b = Application.InputBox("Finish this Sequence 1123_813__") < 100
Application.Speech.Speak "10, 9, 8, 7, 6, 5, 4, 3, 2, 1!"
MsgBox "Hi, you got that answer wrong"
Loop
End If
'How about some music
Application.Speech.Speak "How about some music?"
Ret = MsgBox("How about some music?", vbYesNo)
If Ret = vbNo Then
Application.Speech.Speak "Too bad, here is one from the eighties you will like."
Shell ("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -url https://www.youtube.com/watch?v=oHg5SJYRHA0")
Else
Shell ("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -url https://www.youtube.com/watch?v=oHg5SJYRHA0")
End If
'Third Question
c = Application.InputBox("What are the next three numbers 1,4,9,16,?")
If c = "1,4,9,16,25,36,49" Then 'continue
Else
Do While c = Application.InputBox("What are the next three numbers 1, 4, 9, 16, ?") < 100
'Application.Speech.Speak "Terrible!"
MsgBox "Hi, you got that answer wrong. Don't you love these pop up boxes?"
Loop
End If
'Unlock/Return Control
Application.Speech.Speak "Congradulations! You survived our April Fools
Joke! Happy April Fools!"
ActiveWindow.SelectedSheets.Visible = False
'Cancel = False
End Sub
This example should help you:
Option Explicit
Public Sub TestQuestion()
Dim StopAfter As Long
StopAfter = 100 'to stop after 100 times asking
Do While Application.InputBox("The Declaration of Independence was signed on what day?") <> "July 2nd 1776" And StopAfter > 0
Application.Speech.Speak "Are you even trying?"
MsgBox "You really don't know when the Declaration of Independence was signed?"
StopAfter = StopAfter - 1
Loop
End Sub
Just to give you an idea how this could be frustrating to someone:
My sheet:
My Macro:
Dim X As Double
Option Explicit
Sub Test()
With ActiveWorkbook.Sheets(1)
For X = 2 To 4
Do While .Cells(X, 4) <> .Cells(X, 3)
.Cells(X, 4) = Application.InputBox(.Cells(X, 2))
Loop
Next X
End With
End Sub
:)

VBA - Returning Range or Number from Applilcation.InputBox

I am using Applilcation.InputBox to get a number from the user. Further in the code I am multipying a range of cells with that number.
My problem is that I want to know if the number was written manually or chosen by selecting a cell in the worksheet (that means if the user has written „123“ then „123“ and if he has selected a range then return $A$1).
Code:
Dim output As Variant
Set output = Application.InputBox("Enter Number", "Number for multyplying")
Any advice, please?
I don't think you can do this. Either you set the type to 8, and then you can't enter numbers, or you set it to 1 and then you can't enter references. If you combine it to 9, you still have the problem with Set or no Set.
' Works for ranges
Set Output = Application.InputBox("Enter Number", "Number for multyplying", , , , , , 8)
' Works for literals
Output = Application.InputBox("Enter Number", "Number for multyplying", , , , , , 1)
' Could have worked for both, but it doesn't
Set Output = Application.InputBox("Enter Number", "Number for multyplying", , , , , , 9)
I think the cleanest way to solve this is to implement a UserForm with a RefEdit control.
So, with Application.InputBox I wasn't able to achieve the desired functionality, allthough I still think it's possible somehow... :-)
This is what I came up with (using a UserForm with RefEdit and other tools):
Pay no attention to the picture in the background. I was just trying out stuff... :-) Allthough, I quite like it after all :-)
And this is the code for the commandButton:
(ref_Input being the RefEdit, txb_number the TextBox)
Public gNmr As Variant
Private Sub cmd_OK_Click()
Dim adr As String
If ref_Input.Value <> vbNullString And txb_number.Value <> vbNullString Then
MsgBox "Choose just one option, please.", , "Wrong input"
Exit Sub
Else
If ref_Input.Value = vbNullString And txb_number.Value = vbNullString Then
MsgBox "No input, please try again.", , "Wrong input"
Exit Sub
Else
If txb_number.Value = vbNullString Then
adr = ref_Input.Value
gNmr = adr
Else
If ref_Input.Value = vbNullString Then
gNmr = txb_number.Value
End If
End If
End If
End If
Unload Me
End Sub

Handling non integer in inputbox in VBA

I have a variable called "need" that is defined as an integer. An input box come up and prompts the user. If they type an integer it displays Msgbox "Got your number". If I type a string I get Runtime error '13': type mismatch. I thought if I just used an Else statement, it would say try again. It is not doing that though. Do I need error handling in the Else statement? And if so, what would the line(s) be?
Sub gadgetmanuf()
Dim need As Integer
'Dim rawneed As Single
'Dim rawavailable As Single
need = InputBox("How many gadgets are needed?", "Insert a number")
If TypeName(need) = "Integer" Then
MsgBox ("Got your number")
Else
MsgBox ("Try again")
End If
End Sub
Using an Application.InputBox with type 1 forces the user to enter a number (provides its own error message for text, ranges etc). So all you need to handle is the Cancel option, ie
The code below uses a variant to handle this, as using Cancel with an Integer or Long gives 0 - which could be a valid entry.
Sub TaylorWalker()
redo:
vStr = Application.InputBox("How many gadgets are needed?", "Enter a number", , , , , , Type:=1)
If vStr = False Then GoTo redo
End Sub
longer option
Test that the entered variable is greater than 0
Sub EddieBetts()
Dim StrPrompt As String
Dim lngNum As Long
StrPrompt = "How many gadgets are needed?"
redo:
lngNum = Application.InputBox(StrPrompt, "Enter an integer number (numbers will be rounded)", , , , , , Type:=1)
If lngNum < 1 Then
StrPrompt = "How many gadgets are needed - this must be a postive integer"
GoTo redo
End If
MsgBox "User entered " & lngNum
End Sub
In your example 'need' is an integer data type so it will always be an integer.
Have a look at this:
Sub test()
x = Range("A1").Value
If Int(x) / x = 1 Then
MsgBox "Value is an Integer"
Else
MsgBox "Value is not an Integer"
End If
End Sub
or Assuming A1 has the number, put, in any other cell, the formula:
=IF(INT(A1)=A1,"True","False")

Input Box Error Handling

I am having trouble handling the error associated with a input box "Cancel" click. Or in otherwords, it returns an error within the sub if the value of the input is null. I have tried looking around and still can't seem to get it quite right. Here is my attempt:
Private Sub bttnSavingsExpected_Click()
Dim expected() As String
Dim nPeriods As Integer
Dim counter As Integer
Dim savings As Single
With ActiveSheet.Range("A13")
nPeriods = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
End With
ReDim expected(1 To nPeriods)
counter = 1
For counter = 1 To nPeriods
expected(counter) = Range("A13").Offset(counter, 0).Value
Next
TryAgain:
On Error GoTo ErrH
counter = 1
For counter = 1 To nPeriods
savings = InputBox("How much savings do you expect from " & expected(counter) & "?", "Savings?", Range("A13").Offset(counter, 1).Value)
If savings = "" Then
Exit Sub
Else
Range("A13").Offset(counter, 1).Value = savings
End If
Next
Exit Sub
ErrH:
MsgBox "Please enter value. If the default value is desired then please click 'OK'.", vbOKOnly, "Do Not Click Cancel"
GoTo TryAgain
End Sub
With this attempt, the MsgBox is displayed the first click whether there is a input or not and even if I click "Ok". The second try of clicking "OK" or "Cancel" leads to being kicked back to the editor.
You've got Dim savings As Single and If savings = "" Then. Thats always going to error
Try using Dim savings As Variant
Make sure the variable for the Inbox is set at "", then test the value for False. Much easier than anything else I have seen:
Sub WolfPackURL_input()
Dim TheURL As String
Dim SaveURL As Hyperlink
Set savedURL = Sheets("Data").Range("I1")
TheURL = ""
TheURL = Application.InputBox("Input the Sign-Up URL", "Wolfpack Weekly Players URL", "http://something", 1)
If TheURL = "False" Then
Exit Sub
End If
ThisWorkbook.Worksheets("Data").Activate
Sheets("Data").Range("I1").Hyperlinks.Delete
Sheets("Data").Range("I1").ClearContents
Sheets("Data").Range("I1").Clear
ActiveSheet.Hyperlinks.Add anchor:=Sheets("Data").Range("I1"), Address:=TheURL, ScreenTip:="Open file", TextToDisplay:=TheURL
End Sub

Resources