I want to see if a string starts with or ends with a special character
testString("#Testing") Returns: true
testString("Testing\") Returns: true
testString("#Testing)") Returns: true
testString("Tes#ting~") Returns: true
testString("Tes#ting") Returns: false
testString("Testing") Returns: false
The idea is to use a regular expression
Dim rg As Variant
Set rg = CreateObject("VBScript.RegExp")
rg.Pattern = ""
returnFunc = rg.test(paramString)
However, I am not sure how to create a regular expression to check symbols.
All alternative solutions are welcome
So if it starts or ends with anything other than [a-Z][0-9]
Function test(x)
Dim rg As Variant
Set rg = CreateObject("VBScript.RegExp")
rg.Pattern = "^([^A-Za-z0-9].*|.*[^A-Za-z0-9])$"
test = rg.test(x)
End Function
Sub hoi()
Debug.Print test("#Testing")
Debug.Print test("Testing\")
Debug.Print test("#Testing)")
Debug.Print test("Tes#ting~")
Debug.Print test("Tes#ting")
Debug.Print test("Testing")
End Sub
If you don’t need to change your definition of special characters for different languages or other reasons then you can simply checking the first and last character against a list of valid characters would work.
Public Function testString(text As String)
testString = isCharAlphaNumeric(Left(text, 1)) Or isCharAlphaNumeric(Right(text, 1))
End Function
Public Function isCharAlphaNumeric(char)
Const valid As String = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
isCharAlphaNumeric = InStr(valid, char) = 0
End Function
Public Sub test()
Debug.Print testString("#Testing") ' Returns: true
Debug.Print testString("Testing\") ' Returns: true
Debug.Print testString("#Testing)") ' Returns: true
Debug.Print testString("Tes#ting~") ' Returns: true
Debug.Print testString("Tes#ting") ' Returns: false
Debug.Print testString("Testing") ' Returns: false
End Sub
To check if string does not start and end with alphanumeric characters using the VB Like operator:
If Not "#Testing" Like "[0-9A-Za-z]*[0-9A-Za-z]" Then MsgBox True
If the string might be less than 2 characters:
If string Like "[!0-9A-Za-z]*" Or string Like "*[!0-9A-Za-z]" Then MsgBox True
Related
I have text in a cell A1 as below
((True And False Or True) And (True And (Not True))) And (False Or True)
I need to evaluate this text and put Boolean result (True / False) in another cell B1 using VBA code.
I tried to use Evaluate function, it is not working.
When I read this cell, it always return string type with double quote enclose in both side. Hence it is treated as string and not evaluating the Boolean expression.
"((True And True Or True) And (True And (True))) And (True Or True)"
I want to write this way, but it is not working
If Range("A1").Value = True Then
Range("B1").Value = True
Else
Range("B1").Value = False
End If
I tried to store in Boolean variable also
Dim Result as Boolean
Result = CBool(Range("A1").Value)
as it is string, I am getting type mismatch when I tried to convert using CBool.
You could try something like this, taking advantage of the Eval function in Access.
Public Function EvaluateExpression(Value As String) As Boolean
With CreateObject("Access.Application")
EvaluateExpression = .Eval(Value)
End With
End Function
Public Sub T()
Debug.Print EvaluateExpression("((True And True Or True) And (True And (True))) And (True Or True)")
End Sub
'True
Further to the accepted answer for this question you can use this code:
Option Explicit
Sub Test()
Debug.Print VBABooleanEvaluateOnTheFly("((True And False Or True) And (True And (Not True))) And (False Or True)")
Debug.Print VBABooleanEvaluateOnTheFly("((True And True Or True) And (True And (True))) And (True Or True)")
Debug.Print VBABooleanEvaluateOnTheFly("True")
Debug.Print VBABooleanEvaluateOnTheFly("False")
Debug.Print VBABooleanEvaluateOnTheFly("False Or True")
End Sub
Function VBABooleanEvaluateOnTheFly(strExpression As String) As Boolean
Dim blnResult As Boolean
Dim objVBComponent As Object
Set objVBComponent = ThisWorkbook.VBProject.VBComponents.Add(1)
With objVBComponent
.CodeModule.AddFromString "Function foo() As Boolean: foo = " & strExpression & ": End Function"
If Application.Run(.Name & ".foo") Then
blnResult = True
Else
blnResult = False
End If
End With
ThisWorkbook.VBProject.VBComponents.Remove objVBComponent
VBABooleanEvaluateOnTheFly = blnResult
End Function
You will need to tick the Trust access to the VBA project object model checkbox in the Trust Center settings.
Just to note a couple of things with this technique:
it is slow
there are likely a lot of ways it will break other things
it is vulnerable to code injection by a malicious user e.g. they may enter something like Sheet1.Cells.Delete instead of (True And False etc)
This is what you can do with VBA .Evaluate:
Option Explicit
Public Sub TestMe()
Dim cell01 As Range
Dim cell02 As Range
Set cell01 = Range("A1")
Set cell02 = Range("A2")
Range("A1") = "1+2+3+4+5"
Range("A2") = "TRUE and FALSE"
Debug.Print Evaluate(CStr(cell01))
'Debug.Print CBool(cell02) - this will be an error!
Debug.Print Evaluate(CBool("True") And CBool("False"))
Debug.Print Evaluate("=AND(TRUE,FALSE)")
Debug.Print Evaluate("=AND(TRUE,TRUE)")
Debug.Print Evaluate("=OR(TRUE,TRUE)")
End Sub
If you want to parse the TRUE and FALSE thing (commented in my answer), try to build a formula out of it and to evaluate it.
E.g., TRUE AND FALSE, should be translated to =AND(TRUE,FALSE). This gets evaluated easily by VBA as it is an Excel Formula. The translation is not a trivial task, but an interesting one.
If you could help me I am in need to finding out if a character of the alphabet repeats consecutively 3 or more times in a cell, eg if a cell is "aronfff" or "aaaaaron" I want it to return true otherwise to return false eg "aaron".
Function InRowChars(cell As String) As Boolean
Dim repeats As Integer, char As String, i As Integer
repeats = 0
char = "abcdefghijklmnopqrstuvwxyz"
For i = 1 To Len(cell)
If cell.Value = " " Then
repeats = chars + 1
Else
chars = 0
End If
Next i
If chars = 3 Then
InRowChars = True
Else
InRowChars = False
End If
End Function
I don't know how to get the value of the cell to be checked against the alphabet.
This can be achieved with regular expressions. I've made a function example that also accept the number of minimum characters desired:
'Add a reference to Microsoft VBScript Regular Expressions 5.5
Function ContainsConsecutiveChars(ByRef CellRef As Range, Optional ConsecutiveCount As Long = 3) As Boolean
Dim chars() As String
chars = Split("a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z", ",")
With New RegExp
.Pattern = Join(chars, "{" & ConsecutiveCount & ",}|")
ContainsConsecutiveChars = .test(CellRef.Value2)
End With
End Function
Here is a another regex solution that returns TRUE or FALSE depending on whether or not there are three or more repeating alphabetic characters:
Option Explicit
Function TripleChars(S As String) As Boolean
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Global = True
.Pattern = "([a-z])\1\1"
.ignorecase = True 'edit as desired
TripleChars = .test(S)
End With
End Function
And here is an explanation of the Regex Pattern:
([a-z])\1\1
([a-z])\1\1
Options: Case insensitive; ^$ don’t match at line breaks
Match the regex below and capture its match into backreference number 1 ([a-z])
Match a single character in the range between “a” and “z” [a-z]
Match the same text that was most recently matched by capturing group number 1 \1
Match the same text that was most recently matched by capturing group number 1 \1
Created with RegexBuddy
I see you already have a RegEx answer now. Just finished my version so thought I'd post it to.
#Thunderframe - I liked the optional bit, so have blatantly taken it for my version to.
Public Function RepeatingChars(Target As Range, Optional ConsecutiveCount As Long = 3) As Variant
Dim RE As Object, REMatches As Object
Set RE = CreateObject("VBScript.RegExp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "(.)\1{" & ConsecutiveCount - 1 & ",}"
End With
Set REMatches = RE.Execute(Target.Value)
If REMatches.Count = 0 Then
RepeatingChars = CVErr(xlErrNA)
Else
RepeatingChars = REMatches(0)
End If
End Function
The function will return duplicates of any character, or #NA if no matches found.
Edit
After a quick re-read of your question you can replace the whole If...End If block with RepeatingChars = REMatches.Count <> 0 to return TRUE/FALSE. Remember to change the return type of the function to Boolean in this case.
This is what I have came up with so far:
Option Explicit
Function checkChars(inputCell As String, Optional repeat As Long = 3) As Boolean
Dim cnt As Long
Dim previous As String
Dim countResult As Long
For cnt = 1 To Len(inputCell)
If previous = Mid(inputCell, cnt, 1) Then
countResult = countResult + 1
Else
countResult = 1
End If
If countResult = (repeat) Then
checkChars = True
Exit Function
End If
previous = Mid(inputCell, cnt, 1)
Next cnt
End Function
Public Sub TestMe()
Debug.Print checkChars("lalaaa")
Debug.Print checkChars("lalaala", 2)
Debug.Print checkChars("lalaala", 1)
Debug.Print checkChars("lflalajajala", 2)
End Sub
The idea is that you can also pass the repeat number as an optional value, if it is different than 3. This is what you get as an output from the example:
True
True
True
False
I am implementing a Userform and wish to include some checks on the input data prior to running the Userform. In particular, check all inputs into the Userform textboxs are numerical, although it is valid a textbox is blank or Null. I have tried implementing the following:
Select Case KeyAscii
Case 0, 46, 48 To 57
Case Else
MsgBox "Only numbers allowed"
End Select
But this does not work.
Please, ideas?
Thank you very much!!!!!!!!!
Maybe bit long winded - I usually use a class module and the tag property on the control to decide what can be entered in a textbox.
Create a form with four text boxes.
Give the text boxes these tags:
1;CDBL
2;CINT
3;CSTR
4;CSENTENCE
The numbers are the columns to paste the values into when the form is saved (I haven't described that bit here).
The text describes what can be entered in the textbox - CDBL is numeric with 2 decimal places, CINT is numeric with 0 decimal places, CSTR is for Proper text and CSENTENCE is for sentence text.
Create a class module called clsControlText.
Add this code to the class module:
Public WithEvents txtBox As MSForms.TextBox
Private Sub txtBox_Change()
Static LastText As String
Static SecondTime As Boolean
Const MaxDecimal As Integer = 2
Const MaxWhole As Integer = 1
With txtBox
If InStr(.Tag, ";") > 0 Then
Select Case Split(.Tag, ";")(1)
Case "CDBL", "CCur"
'Allow only numbers with <=2 decimal places
If Not SecondTime Then
If .Text Like "[!0-9.-]*" Or Val(.Text) < -1 Or _
.Text Like "*.*.*" Or .Text Like "*." & String$(1 + MaxDecimal, "#") Or _
.Text Like "?*[!0-9.]*" Then
Beep
SecondTime = True
.Text = LastText
Else
LastText = .Text
End If
End If
SecondTime = False
Case "CINT"
'Allow only whole numbers.
If .Text Like "[!0-9]" Or Val(.Text) < -1 Or .Text Like "?*[!0-9]*" Then
Beep
.Text = LastText
Else
LastText = .Text
End If
Case "CSTR"
'Convert text to proper case.
.Text = StrConv(.Text, vbProperCase)
Case "CSENTENCE"
'Convert text to sentence case (capital after full-stop).
.Text = ProperCaps(.Text)
Case Else
'Allow anything.
End Select
End If
End With
End Sub
Private Function ProperCaps(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object
Set objRegex = CreateObject("vbscript.regexp")
strIn = LCase$(strIn)
With objRegex
.Global = True
.ignoreCase = True
.Pattern = "(^|[\.\?\!\r\t]\s?)([a-z])"
If .Test(strIn) Then
Set objRegMC = .Execute(strIn)
For Each objRegM In objRegMC
Mid$(strIn, objRegM.firstindex + 1, objRegM.Length) = UCase$(objRegM)
Next
End If
ProperCaps = strIn
End With
End Function
Add this code to the user form:
Private colTextBoxes As Collection
Private Sub UserForm_Initialize()
Dim ctrlSelect As clsControlText
Dim ctrl As Control
Me.Caption = ThisWorkbook.Name
Set colTextBoxes = New Collection
For Each ctrl In Me.Controls
Select Case TypeName(ctrl)
Case "TextBox"
Set ctrlSelect = New clsControlText
Set ctrlSelect.txtBox = ctrl
colTextBoxes.Add ctrlSelect
End Select
Next ctrl
End Sub
NB: Not all this code is mine. I found ProperCaps and the code for CDBL elsewhere on this site - or maybe MrExcel.
You could use a basic LIKE or Regexp
Sub Test()
Debug.Print StrCheck("")
Debug.Print StrCheck("hello kitty")
Debug.Print StrCheck("4156")
End Sub
function
Function StrCheck(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "\d+"
'vaidate empty string
If Len(Trim(strIn)) = 0 Then
StrCheck = True
Else
'validate whether non-empty string is numeric
StrCheck = objRegex.Test(strIn)
End If
End Function
Here's my code but i want to know how will I know if the string has special characters like '/' or ':'.Many Thanks. Much great if you can edit my function.
Do Until EOF(1)
Line Input #1, LineFromFile <-----LineFromFile is the string
If HasCharacter(LineFromFile) = True Then
MsgBox "This File should be uploaded to FilePath2"
Else
Blah Blah Blah.......
This is my function
Function HasCharacter(strData As String) As Boolean
Dim iCounter As Integer
For iCounter = 1 To Len(strData)
If ....(Don't know what to say) Then
HasCharacter = True
Exit Function
End If
Next iCounter
End Function
Change your code to this:
Function HasCharacter(strData As String) As Boolean
If InStr(strData, "/") > 0 Or InStr(strData, ":") > 0 Then
HasCharacter = True
Else
HasCharacter = False
End If
End Function
The function InStr returns the position of the string if found, else it returns 0.
You can simply:
if strData like "*[:/]*" then
msgbox "This File should be uploaded to FilePath2"
else
...
Use InStr(stringToCheck, characterToFind)
Function HasCharacter(strData As String) As Boolean
If InStr(strData, "/") + InStr(strData, ":") > 0 Then
HasCharacter = True
End If
End Function
InStr returns 0 if the character cannot be found in the string. In this case, I add the positions of both special characters together. If the sum of these positions is greater than 0, we know that it contains at least one special character. You can separate this logic if you'd like.
if you have multiple characters then can also invert the checking and its easier to edit than multiple or statements
Function HasCharacter(strData As String) As Boolean
Dim iCounter As Integer
For iCounter = 1 To Len(strData)
If Instr ("/:", Mid (strData, iCounter, 1)) > 0 Then
HasCharacter = True
Exit Function
End If
Next iCounter
End Function
How to make a style as a bookmark in word 2010?
You won't be able to use most of the text in the document as the bookmark name. It is just illegal to use certain characters in a bookmark name in Word/VBA. It may be possible to add such characters in bookmark names in an XML format of the document, so if it is required, you can ask a separate question.
This feels like way too much code to post on SO. You really need to explain what framework you have in place and tell us where your hurdles are. We can't do this again. "Works for me". If you have any questions though don't hesitate to ask.
Run the "RunMe" macro at the bottom.
Private Function IsParagraphStyledWithHeading(para As Paragraph) As Boolean
Dim flag As Boolean: flag = False
If InStr(1, para.Style, "heading", vbTextCompare) > 0 Then
flag = True
End If
IsParagraphStyledWithHeading = flag
End Function
Private Function GetTextRangeOfStyledParagraph(para As Paragraph) As String
Dim textOfRange As String: textOfRange = para.Range.Text
GetTextRangeOfStyledParagraph = textOfRange
End Function
Private Function BookmarkNameAlreadyExist(bookmarkName As String) As Boolean
Dim bookmark As bookmark
Dim flag As Boolean: flag = False
For Each bookmark In ActiveDocument.Bookmarks
If bookmarkName = bookmark.name Then
flag = True
End If
Next
BookmarkNameAlreadyExist = flag
End Function
Private Function CreateUniqueBookmarkName(bookmarkName As String)
Dim uniqueBookmarkName As String
Dim guid As String: guid = Mid$(CreateObject("Scriptlet.TypeLib").guid, 2, 36)
guid = Replace(guid, "-", "", , , vbTextCompare)
uniqueBookmarkName = bookmarkName & guid
CreateUniqueBookmarkName = uniqueBookmarkName
End Function
Private Function BookmarkIt(rng As Range, bookmarkName As String)
Dim cleanName As String: cleanName = MakeValidBMName(bookmarkName)
If BookmarkNameAlreadyExist(cleanName) Then
cleanName = CreateUniqueBookmarkName(cleanName)
End If
ActiveDocument.Bookmarks.Add name:=cleanName, Range:=rng
End Function
''shamelessly stolen from gmaxey at http://www.vbaexpress.com/forum/showthread.php?t=37674
Private Function MakeValidBMName(strIn As String)
Dim pFirstChr As String
Dim i As Long
Dim tempStr As String
strIn = Trim(strIn)
pFirstChr = Left(strIn, 1)
If Not pFirstChr Like "[A-Za-z]" Then
strIn = "A_" & strIn
End If
For i = 1 To Len(strIn)
Select Case Asc(Mid$(strIn, i, 1))
Case 49 To 58, 65 To 90, 97 To 122
tempStr = tempStr & Mid$(strIn, i, 1)
Case Else
tempStr = tempStr & "_"
End Select
Next i
tempStr = Replace(tempStr, " ", " ")
MakeValidBMName = tempStr
End Function
Sub RunMe()
Dim para As Paragraph
Dim textOfPara As String
For Each para In ActiveDocument.Paragraphs
If IsParagraphStyledWithHeading(para) Then
textOfPara = GetTextRangeOfStyledParagraph(para)
If para.Range.Bookmarks.Count < 1 Then
BookmarkIt para.Range, textOfPara
End If
End If
Next
End Sub