So what I am looking to find out, because I'm new to regular expressions, is if it's possible to replace my "Invalid" return statement with a similar statement commented out on the next line, where the character and/or character # of the expression failed at.
Let's use "msteede48#hotmail#.com" as an example input for myEmail variable below...
Option Explicit
Function ValidEmail(myEmail As String) As String
Dim regExp As Object
Set regExp = CreateObject("VBScript.Regexp")
If Len(myEmail) < 6 Then
ValidEmail = ""
Else
With regExp
.Global = True
.IgnoreCase = True
.Pattern = "^(?=[a-z0-9#.!#$%&'*+/=?^_`{|}~-]{6,254}$)(?=[a-z0-9.!#$%&'*+/=?^_`{|}~-]{1,64}#)[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*#(?:(?=[a-z0-9-]{1,63}\.)[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+(?=[a-z0-9-]{1,63}$)[a-z0-9](?:[a-z0-9-]*[a-z0-9])?$"
End With
If regExp.Test(myEmail) = True Then
ValidEmail = "Valid"
Else
ValidEmail = "Invalid"
'ValidEmail = "Error at character:" & CodeToDetermineWhatChar#TheRegexpFailedAtGoesHere & " with a(n):" & CodeToDetermineWhatCharTheRegexpFailedAtGoesHere & "."
End If
End If
Set regExp = Nothing
End Function
Where the output would be something like: Error at character:18 with a(n):#.
Related
This is my regex:
Dim vbRegX As Object, vbRegXMatch As Object
Set vbRegX = CreateObject("vbscript.regexp")
With vbRegX
.Global = True
.IgnoreCase = True
.Pattern = "^[a-zA-Z0-9_-]{1,20}$"
End With
code that uses it:
Set vbRegXMatch = vbRegX.Execute(Me.txtProduct.Text)
If vbRegXMatch.Count = 1 Then
MsgBox "This string has invalid characters in it. Illegal characters are out side of the following ranges:" & vbNewLine & vbNewling & "a-z or A-Z" & vbNewLine & vbNewling & "0-9, - or _. Please try again."
Cancel = True
Me.txtProduct.SetFocus
Set vbRegXMatch = Nothing
Set vbRegX = Nothing
Exit Sub
End If
This code fires with invalid characters but not when length is > 20. This is the output given to me by Regex Buddy:
Dim FoundMatch As Boolean
Dim myRegExp As RegExp
Set myRegExp = New RegExp
myRegExp.Pattern = "^[a-zA-Z0-9_-]{1,20}$"
FoundMatch = myRegExp.Test(SubjectString)
Can anyone so kindly point out what Im missing?
visual of the control:
Your regex matches valid input. Thus, you need to .Test(your_string) and if the result is False, you need to fire an error.
Replace
Set vbRegXMatch = vbRegX.Execute(Me.txtProduct.Text)
If vbRegXMatch.Count = 1 Then
with
If vbRegX.Test("1234555") = False Then
Also, since you expect a single match, use
.Global = False
My VBA function should take a string referencing a range of units (i.e. "WWW1-5") and then return another string.
I want to take the argument, and put it in a comma separated string,
So "WWW1-5" should become "WWW1, WWW2, WWW3, WWW4, WWW5".
It's not always going to be a single digit. For example, I might need to separate "XXX11-18" or something similar.
I have never used regular expressions, but keep trying different things to make this work and it seems to only be finding 1 match instead of 3.
Any ideas? Here is my code:
Private Function split_group(ByVal group As String) As String
Dim re As Object
Dim matches As Object
Dim result As String
Dim prefix As String
Dim startVar As Integer
Dim endVar As Integer
Dim i As Integer
Set re = CreateObject("vbscript.regexp")
re.Pattern = "([A-Z]+)(\d+)[-](\d+)"
re.IgnoreCase = False
Set matches = re.Execute(group)
Debug.Print matches.Count
If matches.Count <> 0 Then
prefix = matches.Item(0)
startVar = CInt(matches.Item(1)) 'error occurs here
endVar = CInt(matches.Item(2))
result = ""
For i = startVar To endVar - 1
result = result & prefix & i & ","
Next i
split_group = result & prefix & endVar
Else
MsgBox "There is an error with splitting a group."
split_group = "ERROR"
End If
End Function
I tried setting global = true but I realized that wasn't the problem. The error actually occurs on the line with the comment but I assume it's because there was only 1 match.
I tried googling it but everyone's situation seemed to be a little different than mine and since this is my first time using RE I don't think I understand the patterns enough to see if maybe that was the problem.
Thanks!
Try the modified Function below:
Private Function split_metergroup(ByVal group As String) As String
Dim re As Object
Dim matches As Variant
Dim result As String
Dim prefix As String
Dim startVar As Integer
Dim endVar As Integer
Dim i As Integer
Set re = CreateObject("VBScript.RegExp")
With re
.Global = True
.IgnoreCase = True
.Pattern = "[0-9]{1,20}" '<-- Modified the Pattern
End With
Set matches = re.Execute(group)
If matches.Count > 0 Then
startVar = CInt(matches.Item(0)) ' <-- modified
endVar = CInt(matches.Item(1)) ' <-- modified
prefix = Left(group, InStr(group, startVar) - 1) ' <-- modified
result = ""
For i = startVar To endVar - 1
result = result & prefix & i & ","
Next i
split_metergroup = result & prefix & endVar
Else
MsgBox "There is an error with splitting a meter group."
split_metergroup = "ERROR"
End If
End Function
The Sub I've tested it with:
Option Explicit
Sub TestRegEx()
Dim Res As String
Res = split_metergroup("DEV11-18")
Debug.Print Res
End Sub
Result I got in the immediate window:
DEV11,DEV12,DEV13,DEV14,DEV15,DEV16,DEV17,DEV18
Another RegExp option, this one uses SubMatches:
Test
Sub TestRegEx()
Dim StrTst As String
MsgBox WallIndside("WAL7-21")
End Sub
Code
Function WallIndside(StrIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Dim lngCnt As Long
Set objRegex = CreateObject("VBScript.RegExp")
With objRegex
.Global = True
.IgnoreCase = True
.Pattern = "([a-z]+)(\d+)-(\d+)"
If .test(StrIn) Then
Set objRegMC = .Execute(StrIn)
For lngCnt = objRegMC(0).submatches(1) To objRegMC(0).submatches(2)
WallIndside = WallIndside & (objRegMC(0).submatches(0) & lngCnt & ", ")
Next
WallIndside = Left$(WallIndside, Len(WallIndside) - 2)
Else
WallIndside = "no match"
End If
End With
End Function
#Shai Rado 's answer worked. But I figured out on my own WHY my original code was not working, and was able to lightly modify it.
The pattern was finding only 1 match because it was finding 1 FULL MATCH. The full match was the entire string. The submatches were really what I was trying to get.
And this is what I modified to make the original code work (asking for each submatch of the 1 full match):
I've created a function that will return the Nth reference which includes a sheetname (if it's there), however it's not working for all instances. The regex string I'm using is
'[\w ]+[']!([$]{0,1})([A-Z]{1,2})([$]{0,1})(\d{1,5})
I'm finding though it won't find the first reference in either of the below examples:
='Biscuits Raw Data'!G783/'Biscuits Raw Data'!E783
=IF('Biscuits Raw Data'!G705="","",'Biscuits Raw Data'!G723/'Biscuits Raw Data'!G7005*100)
Below is my Function code:
Function GrabNthreference(Rng As range, NthRef As Integer) As String
Dim patrn As String
Dim RegX
Dim Matchs
Dim RegEx
Dim FinalMatch
Dim Subm
Dim i As Integer
Dim StrRef As String
patrn = "'[\w ]+[']!([$]{0,1})([A-Z]{1,2})([$]{0,1})(\d{1,5})"
StrRef = Rng.Formula
Set RegEx = CreateObject("vbscript.regexp") ' Create regular expression.
RegEx.Global = True
RegEx.Pattern = patrn ' Set pattern.
RegEx.IgnoreCase = True ' Make case insensitive.
Set RegX = RegEx.Execute(StrRef)
If RegX.Count < NthRef Then
GrabNthreference = StrRef
Exit Function
End If
i= -1
For Each Matchs In RegX ' Iterate Matches collection.
Set Subm = RegX(i).submatches
i = i + 1
If i = NthRef -1 Then
GrabNthreference = RegX(i)
Exit Function
End If
'Debug.Print RegX(i)
Next
End Function
Here's my final code
Function GrabNthreference(R As range, NthRef As Integer) As String 'based on http://stackoverflow.com/questions/13835466/find-all-used-references-in-excel-formula
Dim result As Object
Dim testExpression As String
Dim objRegEx As Object
Dim i As Integer
i = 0
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.IgnoreCase = True
objRegEx.Global = True
objRegEx.Pattern = """.*?""" ' remove expressions
testExpression = CStr(R.Formula)
testExpression = objRegEx.Replace(testExpression, "")
'objRegEx.Pattern = "(([A-Z])+(\d)+)" 'grab the address think this is an old attempt so remming out
objRegEx.Pattern = "(['].*?['!])?([[A-Z0-9_]+[!])?(\$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?|\$?[A-Z]+:\$?[A-Z]+|(\$?[A-Z]+\$?(\d)+))"
If objRegEx.Test(testExpression) Then
Set result = objRegEx.Execute(testExpression)
If result.Count > 0 Then
For Each Match In result
Debug.Print Match.Value
If i = NthRef - 1 Then
GrabNthreference = result(i)
Exit Function
End If
i = i + 1
Next Match
Else
GrabNthreference = "No precedencies found"
End If
End If
End Function
This code did lead me onto thinking about using the simple activecell.precedences method but I think the problem is that it won't report offsheet and won't indicate if the formula is relative or absolute.
Any comments welcome but I think I've answered my own question :)
Starting out at a new job and I have to go through a whole lot of documents that my predecessor left. They are MS Word-files that contain information on several hundreds of patents. Instead of copy/pasting every single patent-number in an online form, I would like to replace all patent-numbers with a clickable hyperlink. I guess this should be done with vbscript (I'm not used to working with MS Office).
I have so far:
<obsolete>
This is not working for me:
1. I (probably) need to add something to loop through the ActiveDocument
2. The replace-function probably needs a string and not an object for a parameter - is there a __toString() in vbscript?
THX!
UPDATE:
I have this partially working (regex and finding matches) - now if only I could get the anchor for the hyperlink.add-method right...
Sub HyperlinkPatentNumbers()
'
' HyperlinkPatentNumbers Macro
'
Dim objRegExp, Matches, match, myRange
Set myRange = ActiveDocument.Content
Set objRegExp = CreateObject("VBScript.RegExp")
With objRegExp
.Global = True
.IgnoreCase = False
.Pattern = "(WO|EP|US)([0-9]*)(A1|A2|B1|B2)"
End With
Set Matches = objRegExp.Execute(myRange)
If Matches.Count >= 1 Then
For Each match In Matches
ActiveDocument.Hyperlinks.Add Anchor:=objRegExp.match, Address:="http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=$1&NR=$2&KC=$3"
Next
End If
Set Matches = Nothing
Set objRegExp = Nothing
End Sub
Is this VBA or VBScript? In VBScript you cannot declare types like Dim newText As hyperLink, but every variable is a variant, so: Dim newText and nothing more.
objRegEx.Replace returns the string with replacements and needs two parameters passed into it: The original string and the text you want to replace the pattern with:
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = True
objRegEx.IgnoreCase = False
objRegEx.Pattern = "^(WO|EP|US)([0-9]*)(A1|A2|B1|B2)$"
' assuming plainText contains the text you want to create the hyperlink for
strName = objRegEx.Replace(plainText, "$1$2$3")
strAddress = objRegex.Replace(plainText, "http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=$1&NR=$2&KC=$3"
Now you can use strName and strAddress to create the hyperlink with.
Pro-tip: You can use objRegEx.Test(plainText) to see if the regexp matches anything for early handling of errors.
Problem solved:
Sub addHyperlinkToNumbers()
Dim objRegExp As Object
Dim matchRange As Range
Dim Matches
Dim match
Set objRegExp = CreateObject("VBScript.RegExp")
With objRegExp
.Global = True
.IgnoreCase = False
.Pattern = "(WO|EP|US|FR|DE|GB|NL)([0-9]+)(A1|A2|A3|A4|B1|B2|B3|B4)"
End With
Set Matches = objRegExp.Execute(ActiveDocument.Content)
For Each match In Matches
'This doesn't work, because of the WYSIWYG-model of MS Word:
'Set matchRange = ActiveDocument.Range(match.FirstIndex, match.FirstIndex + Len(match.Value))
Set matchRange = ActiveDocument.Content
With matchRange.Find
.Text = match.Value
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.Execute
End With
ActiveDocument.Hyperlinks.Add Anchor:=matchRange, _
Address:="http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=" _
& match.Submatches(0) & "&NR=" & match.Submatches(1) & "&KC=" & match.Submatches(2)
Next
MsgBox "Hyperlink added to " & Matches.Count & " patent numbers"
Set objRegExp = Nothing
Set matchRange = Nothing
Set Matches = Nothing
Set match = Nothing
End Sub
I trying to remove the html tags using the code below but it does not do anything. I have tried running it again but to no use. Could someone please advise what could be the issue. Attaching a snapshot of the file with html tags. For info, the data comes from the MS Access and the MS Access links to Sharepoint lists.
Sub Import_AccessData()
Dim strtKeyMsgRange As Range
Dim KeyMsgRange As Range
Dim KeyMsgRangeCell As Range
Dim endKeyMsgRangeCell As Range
Set strtKeyMsgRange = Range("B2")
Set endKeyMsgRange = Range("AC13")
Set KeyMsgRange = Range(strtKeyMsgRange, endKeyMsgRange)
For Each KeyMsgRangeCell In KeyMsgRange
a = StripHTML(KeyMsgRangeCell)
KeyMsgRangeCell.Value = a
Next KeyMsgRangeCell
End Sub
Public Function StripHTML(cell As Range) As String
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
Dim sInput As String
Dim sOut As String
sInput = cell.Value
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "<[^>]+>" 'Regular Expression for HTML Tags.
.Pattern = " "
.Pattern = "&"
End With
sOut = RegEx.Replace(sInput, "")
StripHTML = sOut
Set RegEx = Nothing
End Function
You are setting the Pattern property multiple times, it will only retain the last value assigned (&).
You need to use 3 regular expressions("<[^>]+>" => "", " " => " ", "&" => "&"), or one expression that matches all of your inputs ("(&)|( )|(<[^>]+>)" => "") to actually do this.