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
Related
I have a userform, where users are supposed to enter measured dimensions of a part (Quality Management field) into checkboxes. This means no text is allowed, neither some random digits, only numbers.
What I have now, is this:
Private Sub TextBox25_AfterUpdate()
If Not IsNumeric(TextBox25.Value) Then
MsgBox "Invalid data!"
TextBox25.BackColor = RGB(255, 200, 200)
Cancel = True
End If
End Sub
It's not perfect though, user still can type in some random digits like 09 instead of 0,9 and get no error message. I believe allowing only double-type data is the key but I tried the code below and it does not work (I get the error message every time, no matter the data type). Any ideas?
Private Sub TextBox19_AfterUpdate()
If Not VarType(TextBox19.Value) = vbDouble Then
MsgBox "Invalid data!"
TextBox19.BackColor = RGB(255, 200, 200)
Cancel = True
End If
End Sub
The .Value of a TextBox is always a String the name "TextBox" already includes that it is "Text". So it cannot be of type Double unless you take that String and convert it (implicit or explicit) into a Double.
VarType(TextBox19.Value) will always return vbString because it returns the type of the variable not the type of the data inside the variable.
So you actually need to test if it is decimal (not a integer).
The only way to test this properly is to check if the String contains exactly one , (respective . depending on your localization). And then test if this is numeric (otherwise it would accept a,b too).
Option Explicit
Public Sub TestForDecimalInput()
Dim DecimalValue As Double
Dim TextBoxValue As String
TextBoxValue = "9" 'just for testing get your text box value here: TextBoxValue = TextBox19.Value
'this replaces . and , with the actual decimal seperator of your operating system
'so the user is allowed to either enter `0,9` or `0.9`
TextBoxValue = Replace$(TextBoxValue, ".", Application.DecimalSeparator)
TextBoxValue = Replace$(TextBoxValue, ",", Application.DecimalSeparator)
'Check if there is exactly one! decimal seperator
If Len(TextBoxValue) = Len(Replace$(TextBoxValue, Application.DecimalSeparator, "")) + 1 Then
'we need to check for numeric too because yet it could be `a,b` too
If IsNumeric(TextBoxValue) Then
DecimalValue = CDbl(TextBoxValue)
End If
End If
If DecimalValue <> 0 Then
Debug.Print TextBoxValue, "->", DecimalValue
Else
Debug.Print TextBoxValue, "->", "Invalid Data"
End If
End Sub
This would be the result of some example inputs
0.9 -> 0,9
09 -> Invalid Data
0,9 -> 0,9
0,9,0 -> Invalid Data
0,0 -> Invalid Data
9,0 -> 9
9 -> Invalid Data
Note that 9,0 will be accepted as input but 9 will be invalid as input.
Try this. This will limit entires at runtime :)
'~~> Prevent anything other than numbers and decimals
Private Sub TextBox19_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyDelete, _
vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab
If KeyAscii = 46 Then If InStr(1, TextBox19.Text, ".") Then KeyAscii = 0
Case Else
KeyAscii = 0
Beep
End Select
End Sub
'~~> Allow only decimals
Private Sub TextBox19_AfterUpdate()
If Int(Val(TextBox19.Value)) = TextBox19.Value And _
InStr(1, TextBox19.Value, ".") = 0 Then
MsgBox "Invalid data!"
TextBox19.BackColor = RGB(255, 200, 200)
End If
End Sub
Note: If you do not want to allow 9.0 then remove InStr(1, TextBox19.Value, ".") = 0 in the _AfterUpdate()
AND If you want to disable the inputs like 0x.xx then you can use this as well
Private Sub TextBox19_AfterUpdate()
If Int(Val(TextBox19.Value)) = TextBox19.Value And _
InStr(1, TextBox19.Value, ".") = 0 Or _
(Left(TextBox19.Value, 1) = 0 And Mid(TextBox19.Value, 2, 1) <> ".") Then
MsgBox "Invalid data!"
TextBox19.BackColor = RGB(255, 200, 200)
End If
End Sub
via the below code I have a number of validation steps. Currently if a user omits 1 or more data inputs and or inputs incorrectly data they are getting multiple msgboxes. Not a great UI experience, what I'm looking to do is to concatenate these strings into a single msgbox. Bear in mind I'm unable to do so using System.Text etc to generate a string builder using append.
I'm relatively new to vba so if you do post any comments or feedback if you could explain it as fully as possible.
Public Function ValidateMe(strAccNum As String, iDte As Integer, strTRS As String, strPrem As String) As Boolean
' Function tests each input passed to it and validates it. If there is an issue the user is notified with a message box.
Dim blnValAcc As Boolean
Dim blnValDte As Boolean
Dim blValTRS As Boolean
Dim blnValPrem As Boolean
Dim blnValidOverall As Boolean
' Default to Invalid
blnValAcc = False
blnValDte = False
blnValTRS = False
blnValPrem = False
blnValidOverall = False
' Validate Account Number
Dim strMessage As String
Dim strSortCode As String
strMessage = ""
strSortCode = Left(strAccNum, 6)
' AccNum must be 14 characters long and all characters must be numeric
If (Len(strAccNum) = 14 And (IsNumeric(strAccNum) = True)) Then
blnValAcc = True
Else:
strMessage = strMessage & vbNewLine & "Account Number must be 14 characters long and contain only numeric characters."
End If
' 8 and 10 digit account nubmers cannot have a due date change
If (Len(strAccNum) = (8 Or 10) And (IsNumeric(strAccNum) = True)) Then
blnValAcc = False
strMessage = strMessage & vbNewLine & "8 and 10 digit account numbers cannot have a due date change."
End If
' Checks sort code against list of sort codes if the accout number has already passed previous tests
If blnValAcc = True Then
blnValAcc = CheckSortCode(strSortCode)
If blnValAcc = False Then
strMessage = strMessage & "Check sort code."
End If
End If
If blnValAcc = False Then
MsgBox strMessage, , "Check Account Number"
End If
' Validate new Due Date
If (iDte >= 1 And iDate <= 31) Then
blnValDte = True
Else:
blnValDte = False
MsgBox "Please enter a valid due date, a number between 1 and 31", , "Invalid Date"
End If
If ((strTRS = "Yes") Or (strTRS = "No")) Then
blnValTRS = True
End If
' Validate strPrem
If strPrem = "Yes" Then
blnValPrem = True
Else:
MsgBox "Customer must be advised of how change may affect premiums.", , "Premium Changes"
End If
' Validate strTRS
If strTRS = "" Then
valTRS = False
MsgBox "Please select an option from the drop down menu.", , "Customer has been advised of TRS implications?"
End If
If ((blnValAcc = True) And (blnValDte = True) And (blnValTRS = True) And (blnValPrem = True)) Then
blnValidOverall = True
End If
' Function returns true or false
ValidateMe = blnValidOverall
End Function
Basic pattern:
Dim msg as string
If someProblem1 then
msg = msg & iif(len(msg) > 0, vbLf, "") & "Problem1 description"
end if
if someProblem2 then
msg = msg & iif(len(msg) > 0, vbLf, "") & "Problem2 description"
end if
'etc etc
'done testing...
if len(msg) > 0 then
msgbox "There are some problems with your submission:" & vbLf & vbLf & msg,, "Oops"
end if
ValidateMe = (Len(msg) = 0)
I have a problem using the StrComp Function in VBA to compare two Strings.
Public Function upStrEQ(ByVal ps1 As String, ByVal ps2 As String) As Boolean
upStrEQ = False
If StrComp(ps1, ps2, vbTextCompare) = 0 Then
upStrEQ = True
End If
If Len(ps1) = Len(ps2) Then
Debug.Print ps1 & vbNewLine & ps2 & vbNewLine & upStrEQ
End If
End Function
Debug output:
Technischer Name
Technischer Name
Falsch
As you can see the two strings have the same length and equal text but upStrEQ is False and StrComp did not return 0.
Any help would be nice. Thanks.
Update:
Since one of the Strings being passed to the function is read from a cell before I made a sample document so you can reproduce my error: https://www.dropbox.com/s/6yh6d4h8zxz533a/strcompareTest.xlsm?dl=0
StrComp() works quite nice. The problem is with your input, probably you have a hidden space or a new line.
Test your code like this:
Public Function upStrEQ(ByVal ps1 As String, ByVal ps2 As String) As Boolean
If StrComp(ps1, ps2, vbTextCompare) = 0 Then
upStrEQ = True
End If
If Len(ps1) = Len(ps2) Then
Debug.Print ps1 & vbNewLine & ps2 & vbNewLine & upStrEQ
End If
End Function
Public Sub TestMe()
Debug.Print upStrEQ("a", "a")
End Sub
Furthermore, the default value of a boolean function is false, thus you do not need to set it at the beginning.
In order to clean a bit your input, only to letters and numbers, you can use a custom RegEx function. Thus, something like this would always return letters and numbers:
Public Function removeInvisibleThings(s As String) As String
Dim regEx As Object
Dim inputMatches As Object
Dim regExString As String
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.pattern = "[^a-zA-Z0-9]"
.IgnoreCase = True
.Global = True
Set inputMatches = .Execute(s)
If regEx.test(s) Then
removeInvisibleThings = .Replace(s, vbNullString)
Else
removeInvisibleThings = s
End If
End With
End Function
Public Sub TestMe()
Debug.Print removeInvisibleThings("aa1 Abc 67 ( *^ 45 ")
Debug.Print removeInvisibleThings("aa1 ???!")
Debug.Print removeInvisibleThings(" aa1 Abc 1267 ( *^ 45 ")
End Sub
In your code, use it when you are passing the parameters ps1 and ps2 to the upStrEQ.
I want to search for more than one string in a file with vb6
using instr we can do it for single string but I don't know how to use instr for more than one string now how can I search for more than one and if find one of them we receive a message?
Open file For Binary As #1
strData = Space$(FileLen(file))
Get #1, , strData
Close #1
lngFind = InStr(1, strData, string)
That's simply a case of introducing multiple tests for multiple strings...
Dim strArray(10) As String
DIm cntArray(10) As Integer
Dim strData As String
Dim c As Integer
'Set-up your search strings...
...
Open file For Binary As #1
Get #1, , strData
Close #1
For c = 1 to 10
cntArray(c) = Instr(strData, strArray(c))
Next c
If all you want to do is show a true or false message box then we don't need to assign the value to the second array. The For loop could be replaced with...
For c = 1 to 10
If Instr(strData, strArray(c)) > 0 Then
MsgBox "'" & strArray(c) & "' found in file."
'Remove the following line if you want everything to be searched for,
'but leave it in if you only want the first string found...
Exit For
End If
Next c
Really this is a very basic piece of code. If you're looking to write code as anything but a novice then you need to research the commands, functions and structures included in this post. A good place to start, for a complete novice, would be somewhere like http://www.thevbprogrammer.com/classic_vbtutorials.asp or http://www.vb6.us/.
'-----------------------------------------------------------
'perform multiple instr on a string. returns true if all instr pass
'-----------------------------------------------------------
Function bMultiInstr(sToInspect As String, ParamArray sArrConditions()) As Boolean
On Error GoTo err:
Dim i As Integer, iUpp As Integer
iUpp = UBound(sArrConditions) 'instr conditions
For i = 0 To iUpp ' loop them
If InStr(1, sToInspect, sArrConditions(i)) <= 0 Then Exit Function ' if instr returns 0 then exit - [bPasses] will be left false
Next i
bPasses = True
Exit Function
err:
With err
If .Number <> 0 Then
'create .bas named [ErrHandler] see http://vb6.info/h764u
ErrHandler.ReportError Date & ": Strings.bMultiInstr." & err.Number & "." & err.Description
Resume Next
End If
End With
End Function
That is from http://vb6.info/string/instr-multi-perform-instr-checks-multiple-inst-conditions-function/
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