I am new to Visual Basic and I would like to ask how to do a loop until two numbers add up to 100. Basically, I want the user to keep entering the two numbers (via inputbox) until those two numbers add up to 100.
The current codes I have is as follow but it keeps crashing:
Public Sub Task2_B()
Do Until TotalWeight = 100
Do Until Val(weightA) = Int(Val(weightA)) And IsNumeric(weightA) And weightA <> "" And weightA > 0
weightA = Application.InputBox("Please enter weightA:", "Enter a positive integer", 100)
If weightA = False Then Exit Sub
Loop
Do Until Val(weightB) = Int(Val(weightB)) And IsNumeric(weightB) And weightB <> "" And weightB > 0
weightB = Application.InputBox("Please enter weightB:", "Enter a positive integer", 100)
If weightB = False Then Exit Sub
Loop
TotalWeight = Int(weightA) + Int(weightB)
Loop
Debug.Print TotalWeight
End Sub
I think your logic is redundant and repeated. Let's first define what valid input is once:
Public Function InputIsValid(ByVal theInput As String) As Boolean
InputIsValid = (Val(theInput) = Int(Val(theInput))) And Val(theInput) > 0
End Function
The first condition verifies that the input is a whole number. The second states it must be greater than zero. We know that it is numeric and not an empty string at this point so we don't need those additional tests.
Now we use that to validate our input:
Public Sub Task2B()
Dim TotalWeight As Long
Do Until TotalWeight = 100
Dim weightA As Variant
Do
weightA = InputBox("Please enter weightA:", "Enter a positive integer", 100)
If weightA = False Then Exit Sub
Loop Until InputIsValid(weightA)
Dim weightB As Variant
Do
weightB = InputBox("Please enter weightB:", "Enter a positive integer", 100)
If weightB = False Then Exit Sub
Loop Until InputIsValid(weightB)
TotalWeight = Val(weightA) + Val(weightB)
Debug.Print TotalWeight
Loop
End Sub
Notice I declared all the variables in use. I am also checking the state of the input bottom of the loop because it hasn't been set yet at the top.
Finally, we use Val to cast our string to a numeric every time we use it.
Related
I have multiple textboxes on multiple userforms that are for time allocations. For simplicity say userform1 & userform2, with textbox1 & textbox2 on each.
Userform1 is for user input, which places values into a table and userform2 pulls the values from this table and displays in the relevant textbox. I need to restrict both the input of these boxes and the display to the [H]:mm format where minutes cannot exceed 59 but hours can be 25+ i.e 125:59 but not 4:67
I tried a combination of code from both of these threads as well as others but can't seem to get it to work.
Excel VBA Textbox time validation to [h]:mm
Time format of text box in excel user form
eventually i just tried to manipulate user input with message boxes but this still leaves entries open to error
Sub FormatHHMM(textbox As Object)
Dim timeStr As String
With textbox
'Check if user put in a colon or not
If InStr(1, .Value, ":", vbTextCompare) = 0 And Len(.Value) > 1 Then
MsgBox "Please use HH:mm Format"
textbox.Value = ""
textbox.SetFocus
Else
If Right(.Value, 2) > 60 Then
MsgBox "Minutes cannot be more than 59"
textbox.Value = ""
textbox.SetFocus
End If
End If
End With
End Sub
this allows users put alpha characters in and even if correctly input when called from the table is shows as a value instead i.e 5.234... instead of 125:59
How about you split hours and minutes into two seperate input fields on the same inputbox.
So the user has to type in hours and in the next field minutes. This way you can check the input for isnumeric and >60 for seconds.
I know this is not ideal, but it would be a way to evade the given problems.
Have you tried using the Like operator? That allows checking for numeric values in each character-position. I would do it like this:
Function FormatCheck(ByVal strEntered As String)
Dim correctformat As Boolean
If strEntered Like "*#:##" And IsNumeric(Mid(strEntered, 1, InStr(1, strEntered, ":", 1) - 1)) Then
If Mid(strEntered, InStr(1, strEntered, ":", 1) + 1, 999) <= 59 Then
correctformat = True
End If
End If
If Not correctformat Then FormatCheck = "Incorrect format"
End Function
This requires at least one number before the ":"
Edit: Below is a Sub version instead of using a Function. This will pop up a MsgBox like you were using originally. You could probably replace your whole FormatHHMM sub with this without any adverse effect.
Sub FormatCheck(ByVal strEntered As String)
Dim correctformat As Boolean
If strEntered Like "*#:##" And IsNumeric(Mid(strEntered, 1, InStr(1, strEntered, ":", 1) - 1)) Then
If Mid(strEntered, InStr(1, strEntered, ":", 1) + 1, 999) <= 59 Then
correctformat = True
End If
End If
If Not correctformat Then MsgBox "Incorrect format"
End Sub
i think this may be helpful:
Option Explicit
Sub test()
Dim str As String
str = TextBox.Value
'Test string lenght. Maximun lenght number 4
If Len(str) <> 4 Then
MsgBox "Enter a valid time. Proper number of digits are 4."
Exit Sub
End If
'Test if string includes only one ":"
If (Len(str) - Len(Replace(str, ":", ""))) / Len(":") <> 1 Then
MsgBox "Use only one "":"" to separate time."
Exit Sub
End If
'Test how many digits are before and after ":"
If InStr(1, str, ":") <> 2 Then
MsgBox """:"" position should be place 2."
Exit Sub
End If
'Test if number 1,3 & 4 are number
If IsNumeric(Mid(str, 1, 1)) = False Or IsNumeric(Mid(str, 1, 1)) = False Or IsNumeric(Mid(str, 1, 1)) = False Then
MsgBox "Enter number in position 1,3 and 4."
Exit Sub
End If
'Test 2 last to digits
If Right(str, 2) <= 60 Then
MsgBox "Second limit is 60."
Exit Sub
End If
End Sub
You could use regular expressions :
Sub inputTimeFormat()
Dim userInput As String
Dim strPattern As String
Dim msgBoxText As String
Dim regEx As New RegExp
Dim objRegex As Object
strPattern = "(^[0-9]+):([0-5])([0-9])$"
msgBoxText = "Insert time in HH:mm, or hit Cancel to escape"
Set objRegex = CreateObject("vbscript.regexp")
With regEx
.ignorecase = True
.Pattern = strPattern
Do
If userInput <> vbNullString Then msgBoxText = "PLEASE RETRY" & Chr(13) & msgBoxText
userInput = Application.InputBox(msgBoxText, Default:="17:01")
If userInput = "False" Then
MsgBox "User hit cancel, exiting code", vbCritical
Exit Sub
End If
Loop Until .Test(userInput)
End With
MsgBox "Format OK"
End Sub
(you need to activate regular expressions : in VBA, "Tools" > "References" > Check the box "Microsoft VBScript Regular Expressions 5.5" > "OK")
More details on How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops
I'm new to vba script. I am trying to write a function below but couldn't make it out successfully. I really appreciate any help I can get on this.
The code is:
Option Explicit
Dim status As String
Sub StartModule()
Dim index As Integer
Dim result As String
Dim a As Integer
Dim Name As Variant
Range("D4").Value = 1
Range("D5").Value = 5
Range("D6").Value = 9
Range("D7").Value = 2
Dim o: Set o = CreateObject("NAddIn.Functions")
status = ""
Do Until status = "DADA"
result = o.getRandomNumber
Name = Split(result, ",")
If Trim(Name(3)) = Trim(Range("D4").Value) Then
Range("C4").Value = "one"
End If
If Trim(Name(3)) = Trim(Range("D5").Value) Then
Range("C5").Value = "five"
End If
If Trim(Name(3)) = Trim(Range("D6").Value) Then
Range("C4").Value = "nine"
End If
If Trim(Name(3)) = Trim(Range("D7").Value) Then
Range("C7").Value = "two"
End If
Wait 1 '<~~ Wait for a second
If status = "EXIT" Then Exit Do
Loop
End Sub
Sub StopModule()
status = "EXIT"
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
This vba script is calling a getRandomNumber() which is a user defined function in dll file. It generates string of random numbers in the range(1,10); Then the thrid random number in the string is compared with cell values in excel to update cells in excel with some string values.
Bu,the problem is I am getting an error Run-time error 9: Subscript out of range at line If Trim(Name(3)) = Trim(Range("D4").Value) then.
Then the thrid random number in the string is compared with cell
values in excel to update cells in excel with some string values.
You're comparing fourth random number. Your 'Name' elements are (0),(1),(2),(3),(4),...
I suppose there is no element Name(3) as you're getting 'out of range' error.
I have a textbox in userform which will be filled only with digits, commas, or dots. I know how to restrict use of only those characters. My question is it possible to limit filling value to 2 digits after coma/dot?
So when I enter value like: 1023,456 it would not let me type 6 without any action.
Editted:
I can't get this... I tried testing codes given here: Regex to match 2 digits, optional decimal, two digits However it matches too many things. When I type more then 2 digits after comma it still matches as good string. I used for example:
\d{0,2}(\,\d{1,2})?
[0-9]?[0-9]?(\,[0-9][0-9]?)?
What I am doing wrong?
Private Sub netto_Change()
Dim regEx As New VBScript_RegExp_55.RegExp
regEx.Pattern = "\d{0,2}(\,\d{1,2})?"
If regEx.Test(netto.Value) = True Then MsgBox ("It works!")
End Sub
Edit 2:
Okay, I am really close I got this code: ^[0-9]+[\,\.]?[0-9]?[0-9]$ but one thing is missing. This pattern should also apply to string like: 321, with comma\dot at the end but without anything after that.
What to do?
The Textbox controls (there are at least two: ActiveX and UserForm) have events that can be used to QA the data.
On a UserForm:
Private Sub TextBox1_Change()
' QA text here
End Sub
There are other events, like KeyDown() and Exit() that may work better.
This assumes you have event code to trap after the user completes entry to the TextBox. That code should call the following function. The function will return True if the string is good, False if the string is bad. Your code must decide how to handle False :
Public Function QualCheck(S As String) As Boolean
Dim L As Long, CH As String, I As Long
QualCheck = False
L = Len(S)
For I = 1 To L
CH = Mid(S, I, 1)
If CH Like "[0-9]" Or CH = "." Or CH = "," Then
Else
MsgBox "bad character " & CH
Exit Function
End If
Next I
If InStr(S, ".") + InStr(S, ",") = 0 Then
QualCheck = True
Exit Function
End If
If InStr(S, ".") > 0 Then
ary = Split(S, ".")
If Len(ary(1)) > 2 Then
MsgBox "too many characters after ."
Else
QualCheck = True
End If
Exit Function
End If
If InStr(S, ",") > 0 Then
ary = Split(S, ",")
If Len(ary(1)) > 2 Then
MsgBox "too many characters after ,"
Else
QualCheck = True
End If
End If
End Function
NOTE:
This code does not rely on regEx
I found some time to think and I came up with a different idea on how to cope with that.
First of all I used KeyPress event to prevent input of any characters different then 0-9, comma and dot. To make my code work as I wanted I added code to Change event. If sentence checks whether there is comma or dot in my texbox input. If it is, limits maxlength.
Private Sub netto_Change()
Dim znaki As Byte
znaki = Len(netto.Value)
If InStr(1, netto.Value, ".", vbTextCompare) > 0 Or InStr(1, netto.Value, ",", vbTextCompare) > 0 Then
If netto.MaxLength = znaki + 1 Or netto.MaxLength = znaki Then
Else
netto.MaxLength = znaki + 2
End If
Else
netto.MaxLength = 0
End If
End Sub
Private Sub netto_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Asc(",")
Case Asc(".")
Case Else
KeyAscii = 0
End Select
End Sub
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 need to convert a string, obtained from excel, in VBA to an interger. To do so I'm using CInt() which works well. However there is a chance that the string could be something other than a number, in this case I need to set the integer to 0. Currently I have:
If oXLSheet2.Cells(4, 6).Value <> "example string" Then
currentLoad = CInt(oXLSheet2.Cells(4, 6).Value)
Else
currentLoad = 0
End If
The problem is that I cannot predict all possible non numeric strings which could be in this cell. Is there a way I can tell it to convert if it's an integer and set to 0 if not?
Use IsNumeric. It returns true if it's a number or false otherwise.
Public Sub NumTest()
On Error GoTo MyErrorHandler
Dim myVar As Variant
myVar = 11.2 'Or whatever
Dim finalNumber As Integer
If IsNumeric(myVar) Then
finalNumber = CInt(myVar)
Else
finalNumber = 0
End If
Exit Sub
MyErrorHandler:
MsgBox "NumTest" & vbCrLf & vbCrLf & "Err = " & Err.Number & _
vbCrLf & "Description: " & Err.Description
End Sub
Cast to long or cast to int, be aware of the following.
These functions are one of the view functions in Excel VBA that are depending on the system regional settings. So if you use a comma in your double like in some countries in Europe, you will experience an error in the US.
E.g., in european excel-version 0,5 will perform well with CDbl(), but in US-version it will result in 5.
So I recommend to use the following alternative:
Public Function CastLong(var As Variant)
' replace , by .
var = Replace(var, ",", ".")
Dim l As Long
On Error Resume Next
l = Round(Val(var))
' if error occurs, l will be 0
CastLong = l
End Function
' similar function for cast-int, you can add minimum and maximum value if you like
' to prevent that value is too high or too low.
Public Function CastInt(var As Variant)
' replace , by .
var = Replace(var, ",", ".")
Dim i As Integer
On Error Resume Next
i = Round(Val(var))
' if error occurs, i will be 0
CastInt = i
End Function
Of course you can also think of cases where people use commas and dots, e.g., three-thousand as 3,000.00. If you require functionality for these kind of cases, then you have to check for another solution.
Try this:
currentLoad = ConvertToLongInteger(oXLSheet2.Cells(4, 6).Value)
with this function:
Function ConvertToLongInteger(ByVal stValue As String) As Long
On Error GoTo ConversionFailureHandler
ConvertToLongInteger = CLng(stValue) 'TRY to convert to an Integer value
Exit Function 'If we reach this point, then we succeeded so exit
ConversionFailureHandler:
'IF we've reached this point, then we did not succeed in conversion
'If the error is type-mismatch, clear the error and return numeric 0 from the function
'Otherwise, disable the error handler, and re-run the code to allow the system to
'display the error
If Err.Number = 13 Then 'error # 13 is Type mismatch
Err.Clear
ConvertToLongInteger = 0
Exit Function
Else
On Error GoTo 0
Resume
End If
End Function
I chose Long (Integer) instead of simply Integer because the min/max size of an Integer in VBA is crummy (min: -32768, max:+32767). It's common to have an integer outside of that range in spreadsheet operations.
The above code can be modified to handle conversion from string to-Integers, to-Currency (using CCur() ), to-Decimal (using CDec() ), to-Double (using CDbl() ), etc. Just replace the conversion function itself (CLng). Change the function return type, and rename all occurrences of the function variable to make everything consistent.
Just use Val():
currentLoad = Int(Val([f4]))
Now currentLoad has a integer value, zero if [f4] is not numeric.
To put it on one line:
currentLoad = IIf(IsNumeric(oXLSheet2.Cells(4, 6).Value), CInt(oXLSheet2.Cells(4, 6).Value), 0)
Here are a three functions that might be useful. First checks the string for a proper numeric format, second and third function converts a string to Long or Double.
Function IsValidNumericEntry(MyString As String) As Boolean
'********************************************************************************
'This function checks the string entry to make sure that valid digits are in the string.
'It checks to make sure the + and - are the first character if entered and no duplicates.
'Valid charcters are 0 - 9, + - and the .
'********************************************************************************
Dim ValidEntry As Boolean
Dim CharCode As Integer
Dim ValidDigit As Boolean
Dim ValidPlus As Boolean
Dim ValidMinus As Boolean
Dim ValidDecimal As Boolean
Dim ErrMsg As String
ValidDigit = False
ValidPlus = False
ValidMinus = False
ValidDecimal = False
ValidEntry = True
For x = 1 To Len(MyString)
CharCode = Asc(Mid(MyString, x, 1))
Select Case CharCode
Case 48 To 57 ' Digits 0 - 9
ValidDigit = True
Case 43 ' Plus sign
If ValidPlus Then 'One has already been detected and this is a duplicate
ErrMsg = "Invalid entry....too many plus signs!"
ValidEntry = False
Exit For
ElseIf x = 1 Then 'if in the first positon it is valide
ValidPlus = True
Else 'Not in first position and it is invalid
ErrMsg = "Invalide entry....Plus sign not in the correct position! "
ValidEntry = False
Exit For
End If
Case 45 ' Minus sign
If ValidMinus Then 'One has already been detected and this is a duplicate
ErrMsg = "Invalide entry....too many minus signs! "
ValidEntry = False
Exit For
ElseIf x = 1 Then 'if in the first position it is valid
ValidMinus = True
Else 'Not in first position and it is invalid
ErrMsg = "Invalide entry....Minus sign not in the correct position! "
ValidEntry = False
Exit For
End If
Case 46 ' Period
If ValidDecimal Then 'One has already been detected and this is a duplicate
ErrMsg = "Invalide entry....too many decimals!"
ValidEntry = False
Exit For
Else
ValidDecimal = True
End If
Case Else
ErrMsg = "Invalid numerical entry....Only digits 0-9 and the . + - characters are valid!"
ValidEntry = False
Exit For
End Select
Next
If ValidEntry And ValidDigit Then
IsValidNumericEntry = True
Else
If ValidDigit = False Then
ErrMsg = "Text string contains an invalid numeric format." & vbCrLf _
& "Use only one of the following formats!" & vbCrLf _
& "(+dd.dd -dd.dd +dd -dd dd.d or dd)! "
End If
MsgBox (ErrMsg & vbCrLf & vbCrLf & "You Entered: " & MyString)
IsValidNumericEntry = False
End If
End Function
Function ConvertToLong(stringVal As String) As Long
'Assumes the user has verified the string contains a valide numeric entry.
'User should call the function IsValidNumericEntry first especially after any user input
'to verify that the user has entered a proper number.
ConvertToLong = CLng(stringVal)
End Function
Function ConvertToDouble(stringVal As String) As Double
'Assumes the user has verified the string contains a valide numeric entry.
'User should call the function IsValidNumericEntry first especially after any user input
'to verify that the user has entered a proper number.
ConvertToDouble = CDbl(stringVal)
End Function