Input Box Error Handling - excel

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

Related

VBA Input Function shows Run time error, type mismatch

I want to create a input box, and put the input into corresponding cells. But it show type mismatch.
Sub Profit_Projection()
Dim rng As Range
Dim psales As Integer
Dim msg1 As String
psales = InputBox("Please enter the predicted growth of sales next month in decimal form.", "Sales Growth", 1)
If StrPtr(psales) = 0 Then
MsgBox "You clicked Cancel button"
Exit Sub
ElseIf psales = "" Then
MsgBox "You didnt enter input"
Exit Sub
Else
Val (psales)
Range("B5") = psales * 100
If Range("B5").IsNumeric = False Then
msg1 = "The number inputted is is not integer. Please try again in decimal form."
MsgBox msg1, vbOKOnly, "Incorrect Input"
End If
End If
End Sub
Your main problem is that InputBox returns a String (see the official documentation), but you assign it to a numeric variable.
If the user enters some non-numeric data, you will get the type mismatch already at the psales = InputBox - statement.
If the user enters a numeric value, VBA will convert it into a number. But then you get a a type mismatch for the statement psales = "" because you cannot compare a number and a string (even if it is an empty string).
So you should assign the result of the InputBox first to a String variable and then check step by step if the entered value was okay:
Sub Profit_Projection()
Dim rng As Range
Dim psales As Integer
Dim answer
Dim msg1 As String
answer = InputBox("Please enter the predicted growth of sales next month in decimal form.", "Sales Growth", 1)
If StrPtr(answer) = 0 Then
MsgBox "You clicked Cancel button"
Exit Sub
End If
If Trim(answer) = "" Then
MsgBox "You didnt enter anything"
Exit Sub
End If
If Not IsNumeric(answer) Then
MsgBox "You didnt enter a number"
Exit Sub
End If
If CInt(answer) <> Val(answer) Then
MsgBox "You didnt enter an integer "
Exit Sub
End If
psales = Val(answer)
ActiveSheet.Range("B5") = psales * 100
End Sub

add .SendKeys to an existing macro

I have a code that would help me with printing a document from Excel.
It has a couple dialogue questions for adding serial number sequence and number of copies.
Unfortunately, it doesn't open the Print dialogue, where I can select a printer and it's preferences.
The code would just immediately print to my default printer.
I need to add some custom features like 2-side printing and stapling in the top left corner.
For that purpose I want to use .Sendkeys
I tried adding the string Application.SendKeys "%fpr" (my printer preferences dialogue) here and there inside the code to no avail.
Please help inserting the sting.
Alternatively - maybe there is a command for .PrintOut that I could add for 2-side printing and a staple finish?
Private Sub CommandButton1_Click()
Dim xCount As Variant
Dim xJAC As Variant
Dim xID As Variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
Application.SendKeys "%fpr"
LInput:
xJAC = Application.InputBox("Please enter the job number (Leave Out JAC):", "")
xCount = Application.InputBox("Please enter the number of copies you want to print:", "")
xID = Application.InputBox("Please enter the Starting ID of the product:", "")
If TypeName(xJAC) = "Boolean" Then Exit Sub
If TypeName(xCount) = "Boolean" Then Exit Sub
If TypeName(xID) = "Boolean" Then Exit Sub
If (xCount = "") Or (Not IsNumeric(xCount)) Or (xCount < 1) Or (xID < 1) Or (xCount = "") Or (Not IsNumeric(xID)) Then
MsgBox "error entered, please enter again", vbInformation, "Kutools for Excel"
GoTo LInput
Else
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
For c = 0 To xCount - 1
ActiveSheet.Range("E2").Value = "JAC" & xJAC
ActiveSheet.Range("G2").Value = xID + c
ActiveSheet.PrintOut
Next
ActiveSheet.Range("E2").ClearContents
ActiveSheet.Range("G2").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub

Inputbox prevent user from pressing enter when value is blank

I have the following code :
Range("P" & Rows.Count).End(xlUp).offset(1).Value = InputBox("INTRODUCE ACT JUSTIFICATIV")
User must enter letters in inputbox
I want to prevent the user from accidentally pressing enter if value in inputbox is blank with a personalized error message.
And pressing cancel button to exit sub.
Set your Users input to a variable and then test to see whether it is valid or not.
Dim usrInput as String
Do
usrInput = InputBox("INTRODUCE ACT JUSTIFICATIV")
If usrInput = vbNullString Then
MsgBox "Your Error Message"
End If
Loop While usrInput = vbNullString
I don't think that you can force the InputBox to close only if something was entered. Instead, read the result into variable and loop until something valid was entered
Dim answer as string, okay As Boolean
answer = ""
okay = False
Do While Not okay
answer = InputBox("INTRODUCE ACT JUSTIFICATIV")
On Error Resume Next
okay = Range(answer & "1").Address <> ""
On Error GoTo 0
Loop
Now, the InputBox will pop up until a valid column was entered.
Try the next approach, please:
Sub testInputBoxValidate()
Dim strInpB As String
strInpB = InputBox("INTRODUCE ACT JUSTIFICATIV")
If strInpB = "" Then MsgBox "You did not introduce anything!": Exit Sub
Range("P" & Rows.count).End(xlUp).Offset(1).Value = strInpB
End Sub
And a variant to oblige the user inputting something:
Sub testInputBoxValidate()
Dim strInpB As String
Start:
strInpB = InputBox("INTRODUCE ACT JUSTIFICATIV")
If strInpB = "" Then MsgBox "You did not introduce anything!": GoTo Start
Range("P" & Rows.count).End(xlUp).Offset(1).Value = strInpB
End Sub
I would also suggest you to try some more other checking. For instance, that 'ACT JUSTIFICATIV' must not have a specific length (number of digits)? A specific pattern like `xxxx###', where '###' is a three (x) digits number?
You can use Application.InputBox which gives you a little more control. The user will be prompted until they either enter a non-blank string or press the cancel or x buttons
Dim vInput As Variant: vInput = ""
Do
vInput = Application.InputBox("INTRODUCE ACT JUSTIFICATIV", Type:=2) '2 -> String type
If vInput = False Then 'User pressed Cancel or x button
Exit Do
ElseIf Len(vInput) > 0 Then 'User has entered non-blank value
Range("P" & Rows.Count).End(xlUp).Offset(1).Value = vInput
Exit Do
End If
Loop

Fix IsNumeric Loop Bug?

I am trying to fix a simple loop so that the message box won't go away until the user enters an integer.
Here is my code:
Sub PlateMicro()
strName = InputBox(Prompt:="Enter number of wells in plate. The default is 96 (8X12).", _
Title:="PLATE SETUP", Default:="96")
Dim wellCount As Object
Dim numericCheck As Boolean
numericCheck = IsNumeric(wellCount)
If IsNumeric(wellCount) Then
Range("A1").Value = wellCount 'Enter the number of plate wells selected into template.
Else: strName = InputBox(Prompt:="You must enter an integer. Enter number of wells in plate. The default is 96 (8X12)." _
, Title:="PLATE SETUP", Default:=userDefaultChoice)
End If
End Sub
Consider:
Sub intCHECK()
Dim var As Variant
var = "whatever"
While Not IsNumeric(var)
var = Application.InputBox(Prompt:="Enter integer", Type:=2)
Wend
MsgBox "Thanks!"
End Sub
This will allow you to Exit if you touch Cancel

How to deal with a dash in an Excel VBA input variable?

I'm having some trouble with an Excel VBA macro and was hoping you could give me some advice on how to fix it. In the code below, when a user clicks a command button, an InputBox pops up and the user inputs a number in the form XXX-XXXXXX (e.g. 111-222222). Then, the macro takes the value from the column adjacent to button and uses the input variable to replace a certain part of the adjacent column's value. However, when I tried to run the macro and input a number such as 123-456789, nothing happens. I believe it has something to do with the dash that the user inputs, however I'm not sure how to fix it. Please help!
Sub CommandButtonTitleXXXdashXXXXXX_Click()
Application.ScreenUpdating = False
On Error Resume Next
Dim n As Integer
n = Worksheets("REVISIONS").Range("D3:D17").Cells.SpecialCells(xlCellTypeConstants).Count
If n = 15 Then
If MsgBox("Title revision box full. Add manually.", vbOKOnly, "Error") = vbOK Then
Exit Sub
End If
End If
Dim rs As Integer
rs = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
Dim amount As String
Application.ScreenUpdating = True
amount = Application.InputBox("Enter case number:", "")
Application.ScreenUpdating = False
If amount = False Then
Exit Sub
Else
Dim newCell As String
newCell = Replace(Worksheets("TITLE").Range("A" & rs).Value, "XXX-XXXXXX", amount)
Worksheets("REVISIONS").Range("D17").End(xlUp).Offset(1, 0) = newCell
End If
End Sub
I would take your code to an extra step.
No need to declare amount as String. You can keep it as a Variant. Also like I mentioned in the comment above
Can your Case number be like #D1-1%#456? If not then you have an additional problem to handle ;)
See this example. I have commented the code so that you will not have a problem understanding it. Still if you do lemme know :) The other way would be to use REGEX to validate your Case ID. Let me know if you want that example as well.
Code
Sub Sample()
Dim amount As Variant
' 123-$456789 <~~ Invalid
' 123-4567890 <~~ Valid
' ABC-&456789 <~~ Invalid
' 456-3456789 <~~ Valid
amount = Application.InputBox("Enter case number:", "")
'~~> Check if user pressed cancel
If amount = False Then Exit Sub
'~~> Check if then Case ID is valid
If IsValidCaseNo(amount) Then
MsgBox amount
Else
MsgBox "Invalid case ID"
End If
End Sub
Function IsValidCaseNo(sAmount) As Boolean
Dim s As String
Dim i As Long, j As Long
s = sAmount
'
'~~> Initial basic checks
'
'~~> Check if the length is 11 characters
If Len(Trim(s)) <> 11 Then GoTo Whoa
'~~> Check if the string contains "-"
If InStr(1, s, "-") = 0 Then GoTo Whoa
'~~> Check if the 4th character is a "-"
If Mid(s, 4, 1) <> "-" Then GoTo Whoa
'~~> Loop through 1st 3 characters and check
'~~> If they are numbers
For i = 1 To 3
Select Case Asc(Mid(s, i, 1))
Case 48 To 57
Case Else: GoTo Whoa
End Select
Next
'~~> Loop through last 6 characters and check
'~~> If they are numbers
For i = 5 To 11
Select Case Asc(Mid(s, i, 1))
Case 48 To 57
Case Else: GoTo Whoa
End Select
IsValidCaseNo = True
Next
Whoa:
End Function
If you Dim amount as String, you can test it as a string:
Sub GetDash()
Dim amount As String
amount = Application.InputBox(Prompt:="Enter case number", Type:=2)
If amount = "False" Then
MsgBox "You cancelled"
End If
End Sub

Resources