VBA Inputbox to Prevent Decimals - excel

I am trying to develop a tool that will help standardize a description catalog of products. I want to have an input box prompt a user to enter a size. I want to encourage size entries like "5-1/2" and prevent users from entering "5.5". Ideally, if the size was entered with a decimal and not a dash with a fraction, I want a message box to pop up saying they can not do that. It would then need to re-show the input box.
Here is what I have -
Private Sub CS_Other_Click()
Unload Me
Sheets("Fill In").Activate
Worksheets("Fill In").Range("C2").NumberFormat = "#"
Dim other_casing_size As Variant
other_casing_size = InputBox("Fill in the casing size. Syntax MUST be in the form of X-X/X", "New Casing Size")
Range("C2") = other_casing_size
I just dont know the code to prevent an entry with decimals. Even better, if i knew how to code an exact syntax to include or exclude anything I wanted that would be perfect.
Thanks

A while loop, which checks the input string for a dot or comma would work quite ok, I guess:
Sub TestMe()
Dim inputString As String
Dim inputNumeric As Boolean
inputString = InputBox("Please, enter a number!")
inputNumeric = isNumeric(Evaluate(inputString))
Do While InStr(1, inputString, ".") Or _
InStr(1, inputString, ",") Or _
Not inputNumeric
If Not CBool(inputNumeric) Then
MsgBox "You tried to cancel or entered empty value!"
Exit Do
End If
MsgBox "Please, do not write dot or comma!"
inputString = InputBox("Please, enter a number!")
inputNumeric = isNumeric(Evaluate(inputString))
Loop
End Sub
The isNumeric() checks the input for being able to be converted to numeric. Thus 5-1/2 should be ok.
Concerning cancellation or entering empty value from the InputBox() - it really depends on the business logic of the "app", but in the case above - there is a msgbox and it exits the loop.

Write a separate function responsible for that prompt, and use it e.g. like this:
Dim casingSize As String
If GetCasingSize(casingSize) Then
ActiveSheet.Range("C2").Value = casingSize
End If
The function needs to return a Boolean for this to work - it returns True if the input is valid, False if there's no valid input to work with (e.g. prompt was cancelled). What makes this work, is passing the result as a ByRef argument, like this:
Public Function GetCasingSize(ByRef outResult As String) As Boolean
Do
Dim raw As Variant
raw = InputBox("Casing size?")
If VarType(raw) = vbBoolean Then
'handle cancelled prompt:
Exit Do
End If
If ValidateFractional(raw) Then
'handle valid input:
outResult = CStr(raw)
GetCasingSize = True
Exit Do
End If
'handle invalid input:
If MsgBox("The value '" & raw & "' is not valid. Try again?", vbYesNo) = vbNo Then
Exit Do
End If
Loop
End Function
Note the ValidateFractional function is its own concern - a separate, Private function would work, but I'd recommend making it Public, and unit-testing it to make sure it works as intended given a wide variety of edge-case inputs - and having it in a separate function means the logic in GetCasingSize doesn't need to change if the validation needs to be fine-tuned; for example this naive implementation uses the Like operator and would work for 5-1/4, but not for e.g. 15-5/8:
Public Function ValidateFractional(ByVal value As String) As Boolean
ValidateFractional = value Like "#[-]#/#"
End Function
Using Regular Expressions for this would probably be a good idea.

Related

Determining if Cancel Button pressed where InputBox variable declared as Double

I have my variable declared as a double so I can perform mathematical operations on it.
I am trying to determine when the cancel button is pressed.
Dim thckmax As Double
thckmax = InputBox("What is the maximum nominal thickness?", "Enter Max Nominal Thickness Measurement")
If thckmax = 0 Then
GoTo Line3
End If
thckmin = InputBox("What is the minimum nominal thickness?", "Enter Min Nominal Thickness Measurement")
If thckmin = 0 Then
GoTo Line3
End If
thcknom = (thckmax + thckmin) / 2
Worksheets(1).Range("C" & cols + 2).Value = thcknom
.
.
.
Line3: ...
I know I used GoTo. It was a quick and easy fix to get the code up and running.
I get Run-Time error 13 type mismatch. I have also tried CDbl(...),StrPtr(...),IsEmpty(...) and instead of setting them equal to zero I have also tried
If thckmax = "" Then
GoTo Line3
End If`
I cannot get anything to work as far as determining if cancel was pressed and going to Line3:.
All posts I found indicate the declared variable as a string, mine is a double.
You could try something like this to test whether or not the input box was canceled and if it is numeric.
Dim thckmaxTest As String
Dim thckmax As Double
thckmaxTest = InputBox("What is the maximum nominal thickness?", "Enter Max Nominal Thickness Measurement")
If thckmaxTest <> vbNullString and IsNumeric(thckmaxTest) then thckmax = CDbl(thckmaxTest)
If thckmax = 0 Then
GoTo Line3
End If
Dim thckminTest As String
Dim thckmin As Double
thckminTest = InputBox("What is the minimum nominal thickness?", "Enter Min Nominal Thickness Measurement")
If thckminTest <> vbNullString and IsNumeric(thckmibTest) then thckmin = CDbl(thckminTest)
If thckmin = 0 Then
GoTo Line3
End If
thcknom = (thckmax + thckmin) / 2
Worksheets(1).Range("C" & cols + 2).Value = thcknom
As is noted in Microsoft's documentation, the InputBox function returns a string.
How then, you may ask, can you sometimes store the return value from an InputBox to an integer value? Because of implicit coercion. Basically, if you try to store a value in an incompatible variable, VBA attempts to coerce the value to the right data type. If you try to store a string value into a Double variable, VBA attempts to coerce the string into the right data type. This occurs whether you use InputBox or a hard-coded string. For example, the following snippets are equivalent:
Dim x as Double
x = "5"
''''''''''''''''''''''''''''''''''''''
Dim x As Double
x = InputBox("Enter a number")
' user enters 5
When using InputBox, you of course have no control over whether the user enters valid input. Which is why (as #Dude_Scott mentions), you should store user input into a string, and then make sure you have the right value.
If the user clicks Cancel in the inputbox, the empty string is returned (as per documentation above). Since the empty string can't be implicitly coerced to a double, an error is generated. It's the same thing that would happen if the user entered "apples" in the InputBox.
As #Dude_Scott notes, you should use IsNumeric (or something similar) to make sure that the user input is what you need. However, you don't need to include a check for a null or empty string (since IsNumeric returns False for those values). So you really just need something like this:
Public Sub foo()
Dim xDouble As Double, xString As String
xString = InputBox("Enter a number")
If IsNumeric(xString) Then
xDouble = CDbl(xString)
MsgBox xDouble
Else
MsgBox "Invalid number"
End If
End Sub
For more information about coercion, see the following Microsoft articles:
Conversions Between Strings and Other Types
Implicit and Explicit Conversions
All others I have found indicate the declared variable as a string, mine is a DOUBLE
You can't have a Double. The function returns a String, and you can't change that. Using a Double to capture the result will cause problems sooner or later.
What I was trying to explain in a comment box earlier, is that there's a possibility that 0 might be a valid input, so immediately converting the input into a Double is preventing you from being able to tell cancellation from a legit 0 - regardless of the type mismatch error that's guaranteed to happen whenever the resut isn't numeric.
As other answers show, this involves quite a bit of plumbing: enough to warrant being pulled into its own dedicated wrapper function.
The problem is that functions return one value, so you can return a Double and pick a specific "magic value" to mean "input was cancelled", but that's a poor practice.
A better way is to make the wrapper function return a Boolean, and leverage a ByRef parameter to return the result - a function like this returns False if the user cancels the prompt, True if the prompt was not cancelled, and outResult will be either 0 for a non-numeric input, or the input converted to a Double:
Public Function TryGetDoubleInput( _
ByVal prompt As String, _
ByVal title As String, _
ByVal default As String, _
ByRef outResult As Double) _
As Boolean
Dim result As String
result = VBA.Interaction.InputBox(prompt, title, default)
TryGetDoubleInput = StrPtr(result) <> 0 'return false if cancelled
If IsNumeric(result) Then outResult = CDbl(result)
End Function
Can be used like this:
Dim value As Double
If TryGetDoubleInput("Enter a numeric value:", "Prompt", "0.00", value) Then
If value = 0 Then
MsgBox "You entered either 0 or a non-numeric value"
Else
MsgBox "You entered " & CStr(value) ' note the irony
End If
Else
MsgBox "You cancelled the prompt"
End If
Now if you need to treat invalid values differently than 0 (i.e. if 0 is a legit input), consider throwing an error:
Public Function TryGetDoubleInput( _
ByVal prompt As String, _
ByVal title As String, _
ByVal default As String, _
ByRef outResult As Double) _
As Boolean
Dim result As String
result = VBA.Interaction.InputBox(prompt, title, default)
If StrPtr(result) = 0 Then Exit Function 'return false if cancelled
If IsNumeric(result) Then
outResult = CDbl(result)
TryGetDoubleInput = True
Else
Err.Raise 555, "TryGetDoubleInput", "Non-numeric input is invalid."
End If
End Function
And now you can use error handling to handle invalid inputs, and you can now tell a legit 0 from a cancelled inputbox from an arbitrary invalid input:
On Error GoTo ErrHandler
Dim value As Double
If TryGetDoubleInput("Enter a numeric value:", "Prompt", "0.00", value) Then
MsgBox "You entered " & CStr(value) ' note the irony
Else
MsgBox "You cancelled the prompt"
End If
Exit Sub
ErrHandler:
MsgBox Err.Description ' "Non-numeric input is invalid."

Environ function with several users

Im trying to use the environ function to only allow certain users to use a document
Here is my issue: it works with one username, not with several usernames....
I know nested loops could be a solution here but I think there is probably an easier way. Reference tables also didn’t work successfully
The current code looks like
If ((IDnumber=“12345”) or (IDnumber=“1234”) or IDnumber=“123”)) then
Msgbox “approved”
Else: msgbox “denied”
Select Case is the appropriate statement to use, here:
Dim strMsg as String
Select Case IDnumber
Case 12345, 1234, 123
strMsg = "Approved"
Case Else
strMsg = "Denied"
End Select
Msgbox strMsg
If your variable IDnumber is a string (in which case, bad choice of variable name!) then use quotes around each item in the list:
Dim strMsg as String
Select Case IDnumber
Case "alpha", "bravo", "charlie"
strMsg = "Approved"
Case Else
strMsg = "Denied"
End Select
Msgbox strMsg
One could argue if using Select Case (as Olly suggests) or If is the better solution.
However, the syntax for the If would be
If IDnumber = "12345" Or IDnumber = "1234" Or IDnumber = "123" Then
MsgBox "approved"
Else
MsgBox "denied"
End if
You have several mistakes in your code snippet:
unbalanced parentheses. In your case, you don't need any parentheses at all. In VBA, (unlike in many other languages), it is not needed to wrap the whole logical term in parentheses. Also, no need to wrap the single or-conditions into parentheses.
As Marcucciboy2 said in a comment, wrong quote characters, use "
The syntax else: MsgBox is valid but not a good style. The : separates two statements, it's better to write this in 2 lines. Anyhow, you need an ending End If statement
The allowed usernames could be passed as an Array, and then check whether the current username is in that array. The valueInArray() does exactly this:
Sub CheckUser()
Dim userNames As Variant
userNames = Array("User1", "User2", "User3")
If valueInArray(Environ("UserName"), userNames) Then
Debug.Print "User Present"
Else
Debug.Print "User Not Present"
End If
End Sub
Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean
Dim cnt As Long
For cnt = LBound(myArray) To UBound(myArray)
If LCase(CStr(myValue)) = CStr(myArray(cnt)) Then
valueInArray = True
Exit Function
End If
Next cnt
End Function

Am writing a code which could allow user to write a single variable function and the value for which it is to be calculated

Sub CatMain
t = (InputBox("Enter The value at which it is calculated")) 'like 0.5
Fun =(InputBox("Enter The Function")) 'like sin(t)
msgbox Fun 'message should be 0.4794255
End Sub
Here are two approaches for Excel VBA:
The first is straightforward and uses Evaluate():
Sub CatMain1()
Dim t As Double
Dim Fun As String
t = InputBox("Enter The value at which it is calculated")
Fun = InputBox("Enter The Function")
MsgBox Evaluate(Replace(Fun, "t", t))
End Sub
It works as expected on your sample input, but crashes if Fun is tan(t) since it then attempts to evaluate "0.5an(0.5)". You could address this by only replacing t in Fun if t is wrapped in parentheses, but that then requires that e.g. the function t^2 + 1 be entered as (t)^2 + 1, which is annoying.
For another approach, create 2 named cells t and y, then:
Sub CatMain2()
Dim t As Double
Dim Fun As String
t = InputBox("Enter The value at which it is calculated")
Fun = InputBox("Enter The Function")
Range("y").Formula = "=" & Fun
Range("t").Value = t
MsgBox Range("y").Value
End Sub
This lets Excel do the parsing and evaluation, but requires that 2 cells be reserved for this purpose (they can be made hidden if you want) and requires that auto-calculation is enabled (which it is as a default).
Neither way is particularly robust, though I make heavy use of the second approach in some of my code. Error handling should always be used for such code.
For VBScript, only a modification of the first is possible:
Sub CatMain3()
Dim t, Fun
t = InputBox("Enter The value at which it is calculated")
Fun = InputBox("Enter The Function")
MsgBox Eval(Replace(Fun, "t", t))
End Sub
This is fine if you are just running this yourself as a personal script -- but you should be aware that eval is evil when run on strings supplied by untrusted users.

Getting a Message box With Count-if to work

Im 'trying' to make a message box that display how many present and absents there are in a column so the user can either click ok and the data being copied or pressing cancel and ending the code.
The problem is the i cant seem to get the CountIf part to work where it counts the number of absents and presents before displaying them in the Message Box.
Im Pretty new to coding so its probably a real mess but any help and id be grateful:)
Sub SubmitAttendance()
Dim Response As String
Dim Question As String
Dim PresentNumber As String
Dim AbsentNumber As String
Function As Integer
PresentNumber = Countif(Range("E:E"), Present)
AbsentNumber = Countif(Range("E:E"), Absent)
End Function
Question = "PresentNumber Present and AbsentNumber Absent"
Response = MsgBox(Question, vbOKCancel, "Register Totals")
If Response = vbOK Then
Range("E:E").Select
Selection.Copy
Range("F:ZZ").Find("").Select
Selection.PasteSpecial
Else
Exit Function
End If
End Sub
Excel functions are available in WorkSheetFunctions module, like:
WorksheetFunctions.CountIf(Arg1 As Range, Arg2)
Also, pass your second argument as string, not as a variable (VB's hectic nature will declare an uninitialized variable of that name for you, which is probably not what you want.
So your CountIf line should be like:
WorksheetFunction.CountIf( Range("E:E") , "Present")

VBA FileFolderExists pass variable

I found this function on a web
Private Function FileFolderExists(strFullPath As String) As Boolean
On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString then
FileFolderExists = True
End If
EarlyExit:
On Error GoTo 0
End Function
And I want to pass string variable like this
Dim lineText As String
...
ElseIf FileFolderExists(lineText) = False Then
I am getting compile error "byref argument type mismatch"
When I put byval before strFullPath, it doesn't seem to work properly.
I also tried playing with Dir function, it works if I pass literal like "C:\test", but it doesn't work if I pass the variable.
Does anyone have function that check for folder existence and accepts the string variable as parameter ?
Thanks in advance
The problem seems to be that Word adds CR character to every paragraph, or, to be more exact, that the Text property of the Paragraph object returns the paragraph text plus the CR character.
AFAIK, this is the Word's behaviour for every paragraph, even for the last one.
How can this cause a compile error, I do not have a clue. If I take Milan's example:
Private Sub FirstLineFolder()
Dim lineText As String
lineText = ActiveDocument.Paragraphs(1).Range.Text
lineText = Left(lineText, Len(lineText) - 1) 'see below
MsgBox DoesFolderExist("C:\")
MsgBox DoesFolderExist(lineText)
End Sub
it returns true, true if the first line of the document is a valid folder. If I comment the marked line, the program still compiles and runs and returns true, false (with the same document).
There is some info about it on MSDN website
Try this:
Function FolderExists(folderPath As String) As Boolean
Dim f As Object
Set f = CreateObject("Scripting.FileSystemObject")
On Error GoTo NotFound
Dim ff As Object
Set ff = f.GetFolder(folderPath)
FolderExists = True
Exit Function
NotFound:
FolderExists = False
On Error GoTo 0
End Function
I used the following to test it:
Sub Tst()
Dim b As Boolean
Dim s As String
s = "c:\temp"
b = FolderExists(s)
End Sub
And it works as expected.
Generally, I used Scripting.FileSystemObject for all file-related operation in VBA, the native functions are too cumbersome.
It should be also noted that my function all checks for folders, while the original function -- judging by its name -- perhaps also tried to check for existence of files.
New code, it explains exactly what I need, it should be easier for you to try.
I am expecting folder in first line of the Word document, then I have to check if it exists.
Private Sub FirstLineFolder()
Dim lineText As String
lineText = ActiveDocument.Paragraphs(1).range.Text
MsgBox DoesFolderExists("C:\") ' this works
MsgBox DoesFolderExists(lineText) ' this doesnt work, when same folder passed
End Sub
Both my and Martin's function are throwing compiling error I wrote in my first post.
If it matters : Word is 2010, "option explicit" isn't written (I inherited the code, I can't change that)

Resources