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
Related
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
Code to add a sheet and rename that sheet from the user.
Sub tenloops1()
Worksheets.Add
Sheets(ActiveSheet.Name).Select = InputBox("Enter Sheet Name")
End Sub
I would do this slightly different to minimize the error that can happen when you are adding and naming a sheet.
Logic
You have to take care of the following
The sheet name is valid. i.e It is not an empty string or it is not more than 31 characters. Neither it should contain the characters /,\,[,],*,?,:
There should not be a sheet already with that name.
Error Handling On Error GoTo... to catch any other errors that may rise.
Code
Option Explicit
Sub Sample()
Dim Ret As Variant
On Error GoTo Whoa
'~~> Get user input
Ret = InputBox("Enter a valid sheet name")
If Ret = "" Then Exit Sub
'~~> Check if the sheet name is valid
If IsValidSheetName(Ret) = False Then
MsgBox "The sheet name cannot have length more than 31 " & _
"characters. Neither it can contain the characters /,\,[,],*,?,:"
Exit Sub
End If
'~~> Check if there is no other sheet with that name
If DoesSheetExist(Ret) Then
MsgBox "There is already a sheet with that name. Enter a new name"
Exit Sub
End If
'~~> Add the sheet and name it in one go
ThisWorkbook.Sheets.Add.Name = Ret
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Private Function IsValidSheetName(userinput As Variant) As Boolean
Dim IllegalChars As Variant
Dim i As Long
IllegalChars = Array("/", "\", "[", "]", "*", "?", ":")
If Len(userinput) > 31 Then Exit Function
For i = LBound(IllegalChars) To UBound(IllegalChars)
If InStr(userinput, (IllegalChars(i))) > 0 Then Exit Function
Next i
IsValidSheetName = True
End Function
Private Function DoesSheetExist(userinput As Variant) As Boolean
Dim wsh As Worksheet
On Error Resume Next
Set wsh = ThisWorkbook.Sheets(userinput)
On Error GoTo 0
If Not wsh Is Nothing Then DoesSheetExist = True
End Function
ActiveSheet.Name = InputBox("Enter Sheet Name")
and make sure the user does not enter any invalid characters.
You can also do it this way:
Sub tenloops1()
Dim ws As Worksheet
Dim sName as String
sName = InputBox("Enter Sheet Name")
' also may want to check for sName being a valid sheet name here
If Len(sName) > 0 Then
Set ws = Worksheets.Add()
ws.Name = sName
Else
' user clicked cancel
End If
End Sub
Structured example call
[1] Get user input
[2] Repeat in a loop if a sheet name is invalid or exists already
[3] Add sheet and name it
This approach doesn't pretend to be the best one, but you can profit from studying it, as it demonstrates an alternative approach in help functions b) and c)
Sub ExampleCall()
'~~~~~~~~~~~~~~~~~~~~~~~~~
'[1] Get user input
'~~~~~~~~~~~~~~~~~~~~~~~~~
Dim Sheetname As String
Sheetname = InputBox("Enter a valid sheet name or leave blank to exit.")
If Sheetname = vbNullString Then Exit Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~
'[2] Check sheet validity (via help function SheetError()
'~~~~~~~~~~~~~~~~~~~~~~~~~
Do While SheetError(Sheetname, ThisWorkbook)
If Sheetname = vbNullString Then Exit Sub
Sheetname = InputBox("Enter a valid sheet name")
If StrPtr(Sheetname) = 0 Then MsgBox "Cancelled by user.": Exit Sub
Loop
'~~~~~~~~~~~~~~~~~~~~~~~~~
'[3] Add sheet and name it
'~~~~~~~~~~~~~~~~~~~~~~~~~
ThisWorkbook.Sheets.Add.Name = Sheetname
End Sub
Function SheetError()
Controls user inputs of sheet names in ExampleCall and uses two help functions b) and c)
Private Function SheetError(Sheetname As String, wb As Workbook, Optional ShowMsg As Boolean = True) As Boolean
'Purpose: check for possible sheet errors; return True if so
Dim msg As String
'a) Check sheet length
If Not Len(Sheetname) Or Len(Sheetname) > 31 Then
If ShowMsg Then msg = "The sheet name cannot be empty or have more than 31 characters." & vbNewLine
SheetError = True
End If
'b) Check if sheet already exists
If SheetExists(Sheetname, wb) Then
If ShowMsg Then msg = msg & "There is already a sheet with that name. Enter a new name!" & vbNewLine
SheetError = True
End If
'c) Check if the sheet name is valid
If IsValidSheetName(Sheetname) = False Then
If ShowMsg Then msg = msg & "The sheet name must not contain /,\,[,],*,?,: characters."
SheetError = True
End If
If SheetError And ShowMsg Then MsgBox msg, vbExclamation, "Sheet Error"
End Function
Help function b) SheetExists()
Allows a one line check:
Private Function SheetExists(Sheetname As String, wb As Workbook) As Boolean
'Purp.: check if sheet exists
'Date: 2021-03-08
'Auth.: https://stackoverflow.com/users/6460297/t-m
SheetExists = Not IsError(Application.Evaluate("'" & wb.Path & "\[" & wb.Name & "]" & Sheetname & "'!A1"))
End Function
Help function c) IsValidSheetName()
Compares a byte array (by) derived from sheetname characters with an array of illegal characters (illegalAsc) via Application.Match().
Note that
Match() isn't restricted to only 1 array argument!
(shows the 1-based positions of illegal occurrencies, non-findings error)
Count() ignores error elements, so it suffices to detect at least one occurrence of an element
The illegal characters not allowed in sheet names are /\[]*?:
Private Function IsValidSheetName(Sheetname As String) As Boolean
'Auth.: https://stackoverflow.com/users/6460297/t-m
'Purp.: check for valid sheet name
'Date: 2021-03-08
'a) length cannot exceed 31 characters
If Len(Sheetname) > 31 Then Exit Function
'b) define illegal character codes
Dim IllegalAsc As Variant
IllegalAsc = Array(47, 92, 91, 93, 42, 63, 58) ' i.e. /\[]*?:
'c) convert name to byte array
Dim by() As Byte: by = Sheetname
'd) return true if no counted occurrencies of illegal matches
With Application
IsValidSheetName = .Count(.Match(IllegalAsc, by, 0)) = 0 ' edited due to comment
End With
End Function
I am new to VBA and hope the code does what you want.
Sub tenloops1()
Worksheets.Add
ActiveSheet.Name = InputBox("Enter Sheet Name")
End Sub
Facing an issue with coming up with a way to send back my code to a certain place when an IF condition is not met. In the code below, I have included an input box requiring data to be entered however through an IF condition I want to make sure atleast 8 digits are entered, If less than 8 digits are entered then I want to show a msg box "Error" and return to GL_Code position asking user to fill the inputbox again.
Dim GL_CY As Variant
Dim GL_Book As Workbook
GL_CY = Application.GetOpenFilename(Title:="Open GL", FileFilter:="Excel Files (*.xls*),*xls*")
Set GL_Book = Application.Workbooks.Open(GL_CY)
'Filtering Range
Dim GL_Code As Variant, GL_Rng As range, GL_LR As Long
Dim GL_Sheet As Worksheet
Set GL_Sheet = GL_Book.Worksheets(1)
GL_LR = GL_Sheet.range("B" & Rows.Count).End(xlUp).Row
GL_Code = Application.InputBox(Prompt:="Enter GL code to generate its activity ", Title:="Generate GL Activity", Type:=1)
If VBA.IsError(GL_Code) Then
GoTo ErrorHandle
ElseIf Len(GL_Code) < 8 Then
MsgBox "GL Code Not Entered", , "Error"
'Return To GL_Code
End If
Set GL_Rng = GL_Sheet.range("A4:R" & GL_LR).CurrentRegion.Offset(3, 0)
Relevant part of the issue is (Need a code for the commented part at the last line)
GL_Code = Application.InputBox(Prompt:="Enter GL code to generate its activity ", Title:="Generate GL Activity", Type:=1)
If VBA.IsError(GL_Code) Then
GoTo ErrorHandle
ElseIf Len(GL_Code) < 8 Then
MsgBox "GL Code Not Entered", , "Error"
'Return To GL_Code
Naqi,
This should do the trick, at least it worked on my machine. I had to put a phony ErrorHandle label in as you didn't show that in your code.
Option Explicit
Sub Test()
Dim GL_Code As String
Dim GoodEntry As Boolean
GoodEntry = False
Do
GL_Code = Application.InputBox(Prompt:="Enter GL code to generate its activity ", Title:="Generate GL Activity", Type:=1)
If (GL_Code = False) Then Exit Sub 'User pressed CANCEL!
If VBA.IsError(GL_Code) Then
GoTo ErrorHandle
Else
If Len(GL_Code) < 8 Then
MsgBox "GL Code Not Entered", , "Error"
'Return To GL_Code
Else
GoodEntry = True
End If
End If
Loop Until GoodEntry
ErrorHandle:
End Sub
HTH
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
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