I have a program in VBA in which I'd like the user to only enter a number. I want to be able to catch when they they enter a string and have them try again. This is what I've tried:
Sub getInterest()
annualInterest = InputBox("Please enter your annual interest rate as a decimal. ")
If TypeOf annualInterest Is Double Then
'Continue with program
Else
Call getInterest()
End If
End Sub
But this doesn't work.
IsNumeric returns a boolean & doesn't tell you what the type of data user entered, only if it passed or failed numeric check. And while it may work in your case another option is VarType function.
VarType function returns an Integer indicating the subtype of a variable
Sub getInterest()
annualinterest = InputBox("Please enter your annual interest rate as a decimal. ")
If VarType(annualinterest) = vbDouble OR VarType(annualinterest)=vbSingle Then
'crunch interest
Else
getInterest
End If
End Sub
Try something like this...
Sub getInterest()
Dim annualInterest As Double
Do While annualInterest = 0
annualInterest = Application.InputBox("Please enter your annual interest rate as a decimal.", "Annual Interest Rate!", Type:=1)
Loop
MsgBox annualInterest
End Sub
Your syntax in second row is wrong. please try below code. Code will proceed only if user input is a valid number.
Sub getInterest()
annualinterest = InputBox("Please enter your annual interest rate as a decimal. ")
If IsNumeric(annualinterest) Then
'Continue with program
Else
Call getInterest
End If
End Sub
I think you can simply force a numeric entry in Excel VBA by using the existing parameters.
annualInterest = Application.InputBox("Please enter your annual interest rate as a decimal. ", , , , , , , 1)
It will ensure a valid numeric entry and can save the call.
Related
I am extremely new to programming, currently just messing around with console apps. I've created a few things like a login screen and a currency converter but that was with aid from teachers. Never done anything by myself.
I'm wondering if there's any better/shorter way of writing this?
Module Module1
Sub Main()
Dim x As String
Dim Y As String
Dim yes As String
Dim no As String
x = "Please enter your name:"
Y = "Please enter 'Y' or 'N'"
yes = "Y"
no = "N"
Console.WriteLine(x)
Console.ReadLine()
Console.WriteLine("Do you wish to continue?")
yes = Console.ReadLine()
Console.WriteLine(Y)
If yes = "Y" Then
Console.WriteLine("You selected to continue")
Else
If no = "N" Then
Console.WriteLine("You selected to exit")
Environment.Exit(0)
End If
End If
Console.WriteLine("TEXT HERE") 'Text here as I don't know what to put next yet
Console.ReadLine()
Console.ReadLine() 'Just put this here so it doesn't exit straight away
End Sub
I had declared some variables just to try it out rather than just have Console.WriteLine("TEXT") constantly. I'm just trying to find ways of doing things.
I just ran the code again and saw that it's case sensitive to the user input, how would I go about having it be either Y or y and N or n?
You can use the following code:
Sub Main()
Console.WriteLine("Please enter your name:")
Console.ReadLine()
Console.WriteLine("Do you wish to continue?")
Do
Dim selectYN As String = Console.ReadLine()
If selectYN.ToUpper = "Y" Then
Console.WriteLine("You selected to continue")
Exit Do
ElseIf selectYN.ToUpper = "N" Then
Console.WriteLine("You selected to exit")
Environment.Exit(0)
Exit Do
Else
Console.WriteLine("Please enter 'Y' or 'N'")
End If
Loop
Console.WriteLine("TEXT HERE") 'Text here as I don't know what to put next yet
Console.ReadLine()
Console.ReadLine() 'Just put this here so it doesn't exit straight away
End Sub
The code is much more minified than your code. I added also a loop until the user added a valid answer for the yes/no question. The user have to enter one of the following values to break the loop: n, N, y, Y. If the value is not valid the question appears again to give himn a chance to enter a new value again.
How would I go about having it be either Y or y and N or n?
In this case you have the possibility to convert the letter toLower or toUpper. In the example above toUpper is used to check against N and Y.
I'm working on my first project for my visual basic programming class.
I am trying to have this condition statement say if the discount rate is .1 or (10%), then add to the count of customers who got the discount (msngFrequentFlyers) and add to the accumulator that keeps track of total discounts given (msngTotalDiscounts).
I'm very new to all this- please help! Project is due tonight.
Here's my code:
Public Class frmTaxiConsole
'Modular Variable Declaration Section
'Declares msngDiscountRate and sets inital value to -1 for testing user input
Dim msngDiscountRate As Single = -1
'Declares all counter variables
Dim msngNumberOfRides As Single
Dim msngNumberOfFrequentFlyers As Single
'Declares all accumulator variables
Dim msngRevenue As Single
Dim msngTotalDiscounts As Single
Dim msngBillableMiles As Single
If the radio button for the discount is checked:
Private Sub radFrequentFlyer_CheckedChanged(sender As Object, e As EventArgs) Handles radFrequentFlyer.CheckedChanged
msngDiscountRate = 0.1 'Sets discount rate to 10% upon selection of radio button
End Sub
This is the if statement that's not working, in the "Process Transaction" click event:
If msngDiscountRate = "0.1" Then 'Checks to see if this transaction had any discount
msngNumberOfFrequentFlyers += 1 'If so, adds 1 to the number of discounts given
msngTotalDiscounts = msngTotalDiscounts + (sngSubTotal * msngDiscountRate) 'Also adds the discount amount to the total discounts accumulator (without making it negative)
End If
Here's the entire code for the "Process Transaction" click event:
Private Sub btnProcessTx_Click(sender As Object, e As EventArgs) Handles btnProcessTx.Click
'Local Variable Declaration Section
Dim sngMilesDriven As Single
Dim dblOdometerStart As Double
Dim dblOdometerEnd As Double
Dim sngInitialFee As Single
Dim sngPerMileFee As Single
Dim sngMileageCharge As Single
Dim sngSubTotal As Single
Dim sngDiscount As Single
Dim sngTotalDue As Single
'Data Input + Testing Section
'Changes all text box backcolors white, in case they had been turned red due to an error
txtOdometerStart.BackColor = Color.White
txtOdometerEnd.BackColor = Color.White
txtInitialFee.BackColor = Color.White
txtPerMileFee.BackColor = Color.White
'Try/Catch validates user input for Inital Fee
Try
'Attempts to convert user input to Single and store as a local variable
sngInitialFee = CSng(txtInitialFee.Text)
Catch ex As Exception
'If error occurs, displays a messagebox, changes background color of relavent text box, and exits sub.
MessageBox.Show("Please enter a valid initial fee.", "Invalid Initial Fee", MessageBoxButtons.OK)
txtInitialFee.BackColor = Color.Red
txtInitialFee.Focus() 'Focuses in text box where error occured so user can fix
Exit Sub
End Try
'Try/Catch validates user input for Per-Mile Fee
Try
'Attempts to convert user input to Single and store as a local variable
sngPerMileFee = CSng(txtPerMileFee.Text)
Catch ex As Exception
'If error occurs, displays a messagebox, changes background color of relavent text box, and exits sub.
MessageBox.Show("Please enter a valid per-mile fee.", "Invalid Per-Mile Fee", MessageBoxButtons.OK)
txtPerMileFee.BackColor = Color.Red
txtPerMileFee.Focus() 'Focuses in text box where error occured so user can fix
Exit Sub
End Try
'Try/Catch validates user input for starting milage
Try
'Attempts to convert user input to Double and store as a local variable
dblOdometerStart = CDbl(txtOdometerStart.Text)
Catch ex As Exception
'If error occurs, displays a messagebox, changes background color of relavent text box, and exits sub.
MessageBox.Show("Please enter a valid starting milage.", "Invalid Odometer Reading", MessageBoxButtons.OK)
txtOdometerStart.BackColor = Color.Red
txtOdometerStart.Focus() 'Focuses in text box where error occured so user can fix
Exit Sub
End Try
'Try/Catch validates user input for ending milage
Try
'Attempts to convert user input to Double and store as a local variable
dblOdometerEnd = CDbl(txtOdometerEnd.Text)
Catch ex As Exception
'If error occurs, displays a messagebox, changes background color of relavent text box, and exits sub.
MessageBox.Show("Please enter a valid ending milage.", "Invalid Odometer Reading", MessageBoxButtons.OK)
txtOdometerEnd.BackColor = Color.Red
txtOdometerEnd.Focus() 'Focuses in text box where error occured so user can fix
Exit Sub
End Try
'If statement ensures Inital Fee is a positive number
If sngInitialFee < 0 Then
'If error occurs, displays a messagebox, changes background color of relavent text box, and exits sub.
MessageBox.Show("Initial Fee cannot be negative.", "Invalid Inital Fee", MessageBoxButtons.OK)
txtInitialFee.BackColor = Color.Red
txtInitialFee.Focus() 'Focuses in text box where error occured so user can fix
Exit Sub
End If
'If statement ensures Per-Mile Fee is a positive number
If sngPerMileFee < 0 Then
'If error occurs, displays a messagebox, changes background color of relavent text box, and exits sub.
MessageBox.Show("Per-Mile Fee cannot be negative.", "Invalid Per-Mile Fee", MessageBoxButtons.OK)
txtPerMileFee.BackColor = Color.Red
txtPerMileFee.Focus() 'Focuses in text box where error occured so user can fix
Exit Sub
End If
'If statement checks to make sure starting milage is smaller number than ending milage
If dblOdometerEnd <= dblOdometerStart Then
'If ending milage is smaller number than starting milage, displays a messagebox and exits sub.
MessageBox.Show("Your ending mileage cannot be less than or equal to your starting mileage. Please check your odometer readings.", "Invalid Odometer Reading", MessageBoxButtons.OK)
txtOdometerStart.Focus() 'Focuses in starting odometer reading text box so user can fix
Exit Sub
End If
'If statement checks to make sure both odometer readings are positive numbers.
If dblOdometerEnd < 0 Or dblOdometerStart < 0 Then
'If either odometer reading is negative, displays a messagebox and exits sub.
MessageBox.Show("Both your odometer readings must be positive numbers. Please check your odometer readings.", "Invalid Odometer Reading", MessageBoxButtons.OK)
txtOdometerStart.Focus() 'Focuses in starting odometer reading text so user can fix
Exit Sub
End If
'If statement checks to ensure user has seleted one of the two radio buttons
If msngDiscountRate = -1 Then
'If msngDiscountRate is the same as the initial value, neither option has been chosen, an error message is shown, and sub exited.
MessageBox.Show("Please choose a frequent flyer status.", "Frequent Flyer?", MessageBoxButtons.OK)
Exit Sub
End If
'Calculations Section
sngMilesDriven = CSng(dblOdometerEnd - dblOdometerStart) 'Subtracts starting mileage from ending mileage, converts to single, stores as var sngMilesDriven
sngMileageCharge = sngMilesDriven * sngPerMileFee 'Multiplies the miles driven by the per-mile fee and stores as var sngMileageCharge
sngSubTotal = sngMileageCharge + sngInitialFee 'Adds the milage charge to the initial fee, stores as var sngSubTotal
sngDiscount = sngSubTotal * msngDiscountRate * -1 'Multiplies subtotal by discount rate, makes negative, stores as var sngDiscount
sngTotalDue = sngSubTotal + sngDiscount 'Subtracts discounts from subtotal, stores as var sngTotalDue
'Counter and Accumulator Operations
msngNumberOfRides += 1 'Adds 1 to the number of rides given
If msngDiscountRate = "0.1" Then 'Checks to see if this transaction had any discount
MsgBox(msngDiscountRate)
msngNumberOfFrequentFlyers += 1 'If so, adds 1 to the number of discounts given
msngTotalDiscounts = msngTotalDiscounts + (sngSubTotal * msngDiscountRate) 'Also adds the discount amount to the total discounts accumulator (without making it negative)
End If
msngRevenue = msngRevenue + sngTotalDue 'Adds the total due for current transaction to revenue accumulator
msngBillableMiles = msngBillableMiles + sngMilesDriven 'Adds miles from this transaction to running total
'Output Section
'Displays above calculations in respective labels and formats as currency if neccecary.
lblMilesDrivenOutput.Text = sngMilesDriven
lblSumInitialFeeOutput.Text = FormatCurrency(sngInitialFee) 'Formats sngInitialFee as currency and displays in lblSumInitialFeeOutput
lblSumMilageChargeOutput.Text = FormatCurrency(sngMileageCharge)
lblSumSubTotalOutput.Text = FormatCurrency(sngSubTotal)
lblSumDiscountOutput.Text = FormatCurrency(sngDiscount)
lblSumTotalDueOutput.Text = FormatCurrency(sngTotalDue)
'Displays all counter and accumulator variables after they are updated
lblTotalRidesOutput.Text = msngNumberOfRides
lblFrequentFlyersOutput.Text = msngNumberOfFrequentFlyers
lblRevenueOutput.Text = FormatCurrency(msngRevenue)
lblTotalDiscountsOutput.Text = FormatCurrency(msngTotalDiscounts)
lblBillableMilesOutput.Text = msngBillableMiles
End Sub
Firstly as mentioned above you'll need to remove the quotes around the 0.1 in your if statement, this won't work as it's comparing a number to a string.
I'm no expert on floating-point arithmetic, but as Plutonix alludes to, I think the problem when you tried it without quotes is that the 0.1 you're comparing your msngDiscountRate in the if statement defaults to a Double, whereas you've declared your variable as a Single, so the if statement evaluates to false.
You could either declare your msngDiscountRate variable as Double instead, or cast the 0.1 to a Single to get around it. These simple examples might help -
'Variable declared as a Single, compared to 0.1 (a Double) - If statement evaluates to false
Dim msngDiscountRateExample1 As Single = -1
msngDiscountRateExample1 = 0.1
If msngDiscountRateExample1 = 0.1 Then
Debug.Print(msngDiscountRateExample1.ToString)
End If
'Variable declared as a Double, compared to 0.1 (another Double) - If statement evaluates to true
Dim msngDiscountRateExample2 As Double = -1
msngDiscountRateExample2 = 0.1
If msngDiscountRateExample2 = 0.1 Then
Debug.Print(msngDiscountRateExample2.ToString)
End If
'Variable declared as a Single, compared to 0.1 (a Double) which is *cast* as a Single - If statement evaluates to true
Dim msngDiscountRateExample3 As Single = -1
msngDiscountRateExample3 = 0.1
If msngDiscountRateExample3 = CSng(0.1) Then
Debug.Print(msngDiscountRateExample3.ToString)
End If
I am new to VBA and I'm trying to create a macro that from a inputBox accepts a number between 0 and 1000 and converts it to hexadecimal. Well it works, but I am struggling to keep the program accepting that range ( 0 - 1000). This is what happens:
If I input -1 it throws a error;
If I input -1001 it throws a FFFFFFFC17;
If I input any value above 1000 it doesn't throw a MsgBox (I am not familiar with causing error on excel for now).
I've done first like this:
Sub DecToHex()
Dim inputDec As Integer
Dim outputHex As String
inputDec = InputBox("Decimal?")
If inputDec <= 1000 And inputDec >= 0 Then
outputHex = Application.WorksheetFunction.Dec2Hex(inputDec)
MsgBox ("Hex: " + outputHex)
Else
MsgBox ("Error! Please define decimal. It must be larger than zero and less than 1001")
inputDec = InputBox("Decimal?")
outputHex = Application.WorksheetFunction.Dec2Hex(inputDec)
MsgBox ("Hex: " + outputHex)
End If
End Sub
But then I thought well inputBox gives me input as string, so maybe I should accept values as string, so I changed:
Dim inputDec As Integer
'Changed to
Dim inputDec As String
Which still did a poorly control on variables ( ie. it accepts -1200, as also 1200 ). So can you point out what am I doing wrong? Maybe it's the Worksheet Function I'm not reading well. I know it's newbie mistake but it's important for me to understand how to control these input variables from inputBox.
You need to declare the inputDec As Variant
You need to Handle the Cancel Button
You need to put the code in a loop so that when user enters an invalid number, the inputbox can pop up again.
You need to use Application.InputBox with Type:=1 so that only numbers can be accepted.
Try this
Sub DecToHex()
Dim inputDec As Variant
Dim outputHex As String
Do
inputDec = Application.InputBox("Decimal?", Type:=1)
'~~> Handle Cancel
If inputDec = "False" Then Exit Do
If inputDec <= 1000 And inputDec >= 0 Then
outputHex = Application.WorksheetFunction.Dec2Hex(inputDec)
MsgBox ("Hex: " + outputHex)
Exit Do '<~~ Exit the loop
Else
MsgBox ("Error! Please define decimal. It must be larger than zero and less than 1001")
End If
Loop
End Sub
I am taking a VBA class and am completely stuck on this problem. We CANNOT use the masked text box, which would solve this problem. Instead the professor actually wants me to learn the code, can you imagine?
All kidding aside, the user needs to enter a gas price into a text box, then hit calculate to receive the total cost of the trip. There is much more to the interface but will spare you the details. If a user enters anything else number than a positive number with one decimal place, it should return an error. I have figured out 0 or 0000 as well as a negative number such as -3.45. Now I have to get any text or special characters to give me an error as well as something like 34.56.12.45. You never know, a user may feel the need to type in their IP address. The key to the assignment is that I catch all probable user errors.
Here is what I've written for the calculation as well as catch the errors. I have tried the Try/Catch statements as well. Nothing worked but I got the first two parts of the IF statement to work yet always failing on the last IF part until it gets to the calculation.
Private Sub btnCalc_Click(sender As Object, e As EventArgs) Handles btnCalc.Click
Dim Mileage As Decimal
Dim Miles As Decimal
Dim GasPrice As Decimal
Dim Cost As Decimal
If CDec(txtbxGasPrice.Text) = 0 Then
MessageBox.Show("Please enter a positive dollar amount")
txtbxGasPrice.Text = String.Empty
End If
If CDec(txtbxGasPrice.Text) < 0 Then
MessageBox.Show("Please enter a positive dollar amount")
txtbxGasPrice.Text = String.Empty
End If
If Cost = CDec((Miles / Mileage) * GasPrice) Then
Miles = CDec(lblTMiles.Text)
Mileage = CDec(lblMileage.Text)
GasPrice = CDec(txtbxGasPrice.Text)
lblTotalCost.Text = Cost.ToString("C2")
End If
If CBool(txtbxGasPrice.Text = "") Then
MsgBox("You must enter a dollar amount")
End If
*If Not IsNumeric(txtbxGasPrice.Text) Then
MessageBox.Show("Please enter a positive dollar amount")
txtbxGasPrice.Text = String.Empty*
End If
End Sub
'I have placed this at the top, in the middle, at the bottom but no luck. What am I missing?
Appreciate your thoughts - Lauren
This one seems to meet your criteria and pass David's tests:
Function IsValid(txt As String) As Boolean
If Not IsNumeric(txt) Then
Exit Function
End If
If Len(txt) < 2 Then
Exit Function
End If
If Not Mid(txt, Len(txt) - 1, 1) = "." Then
Exit Function
End If
If Not txt > 0 Then
Exit Function
End If
IsValid = True
End Function
This seems like a perfect application of regular expressions, but could be out of scope for this problem, maybe even better though vb has a Decimal.TryParse(or parse) that will take a string and try to parse it to a decimal.
http://msdn.microsoft.com/en-us/library/system.decimal.tryparse.aspx
on a side not I'm not 100% sure how it acts with xx.xx.xx but I'm betting it will fail and help your problem
I'm going to expand on CSgoose's idea to use RegEx, it seems a lot more reliable. I am very, very green when it comes to using RegEx but I try to work on Q's here at SO, so this may not be the optimal pattern to match, but a function like this seems to do the trick when I test a few value.
0/0.0/0.00 = False
-1.5 = False
1.5 = True
5.45 = False
Steve = False
Steve.6 = False
Steve6.58 = False
6.574.2 = False
A value that evaluates to 0 will return false. Negative values return false. Value must have a decimal component, be comprised of any # of digits (this can be tweaked if you want to limit it, eg., to ##.# format, etc.). Matches full text only, so things like IP addresses won't return true, etc.
NOTE This is VBA, but should be easily adaptable for your purposes)
Sub YourSub()
If Not IsMatch(CStr(txtbxGasPrice.Text)) Then
MsgBox "Please ensure that the value you enter is a positive dollar amount, to 1 decimal place!", vbCritical, "Invalid Gas Price Value!"
End IF
End Sub
This function requires enabling reference to Microsoft VBScript Regular Expressions 5.5, or you could use late-binding.
Function IsMatch(str As String) As Boolean
'Tests for a positive numeric value, formatted 0.0 with a mandatory decimal component
' exact match only
Dim re As RegExp
Dim allMatches As MatchCollection
Dim retVal As Boolean
retVal = False 'by default
If Not IsNumeric(str) Then GoTo EarlyExit 'ignore any non-numeric value
Set re = New RegExp
re.Pattern = "\d*\.[0-9]"
Set allMatches = re.Execute(str)
If allMatches.Count = 1 Then
'If there are multiple matches, then I think safe to say it's not a match,
' make sure it's a full string match
If str > 0 Then
retVal = (allMatches(0) = str)
End If
End If
EarlyExit:
Set re = Nothing
IsMatch = retVal
End Function
Update to force, for example, ##.# format, you could do
re.Pattern = "[1-9]?\d\.\d"
I'm able to use the code below to check whether or not a user inputs a string in a datagridview cell. If the user inputs a string a message pops up to tell them "only numeric entries are allowed". This is exactly what I want my code to do. However if I try to use this code in a column of data populated with numbers I get an error message that says "error happened, parsing commit". If anyone is able to figure out what the issue is here I would greatly appreciate it!
If (e.ColumnIndex = 3) Then 'checking numeric value for column 3 only
Dim value As String = DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).Value
For Each c As Char In value
If Not Char.IsDigit(c) Then
MessageBox.Show("Please Enter numeric Value")
DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).Value = 3 'This will set the defaultvalue of the datagrid cell in question to the value of "3"
Exit Sub
End If
Next
End If
This solution not only checks for non-integer values it also works for every column populated with numbers for the entire datagridview. Also if the user inputs a non-integer if will supply a default value for the datagridviewcell, this default value is the previous number.
Private Sub DataGridView1_DataError(ByVal sender As Object, _
ByVal e As DataGridViewDataErrorEventArgs) _
Handles DataGridView1.DataError
If StrComp(e.Exception.Message, "Input string was not in a correct format.") = 0 Then
MessageBox.Show("Please Enter a numeric Value")
'This will change the number back to original
DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).Value = " "
End If
End Sub
Do this in cellvalidating event ...
If (e.ColumnIndex = 3) Then 'checking numeric value for column 3 only
If Not Isnumeric(e.Formatted.Value) Then
MessageBox.Show("Please Enter numeric Value")
DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).Value = 3 'This will set the defaultvalue of the datagrid cell in question to the value of "3"
Exit Sub
End If
End If