I have a function calling another function. This was all one function but it got too big.
Function Wave(SubjectLine As Range)
Dim SubV
SubV = SubjectLine.Value
Dim regEx, Match, Matches ' Create variable.
Set regEx = New RegExp ' Create a regular expression.
regEx.Pattern = "[0-9][0-9][0-9][0-9][0-9][-][a-z][a-z][a-z]?[a-z]?[a-z]?[a-z]"
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
Set Matches = regEx.Execute(SubV) ' Execute search.
For Each Match In Matches ' Iterate Matches collection.
RetStr = RetStr & Match.Value
Next
If RetStr = 0 Then
WaveSort = "Not Found"
Exit Function
End If
DivR = DivResult(Left(RetStr, 5))
...then something else
Function DivResult(PL As Integer)
Select Case PL
Case 1
DivResult = "Wave1"
...
Case Else
DivResult = "NO"
End Select
End Function
My result is alway Data Type Mismatch. I have tried changing variable types and renaming and everything I can think of. Left turns the variable to an integer so i just embraced it but nothing seems to work.
Do you have an idea of what is wrong in this code please? It should extract all caps and the pattern "1WO" if available.
For example in "User:399595:Account:ETH:balance", i should have "UAETH" and in "User:197755:Account:1WO:balance" i should have "UA1WO"
Thank you
Option Explicit
Function ExtractCap(Txt As String) As String
Application.Volatile
Dim xRegEx As Object
Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
If xRegEx.Pattern = "[^A-Z]" Then
xRegEx.Global = True
xRegEx.MultiLine = False
ExtractCap = xRegEx.Replace(Txt, "")
Set xRegEx = Nothing
Else: xRegEx.Pattern = "1WO"
ExtractCap = xRegEx.Execute(Txt)
End If
End Function
I'm not a "RegEx" expert, so you may want to try an alternative:
Function ExtractCap(Txt As String) As String
Application.Volatile
Dim i As Long
For i = 1 To Len(Txt)
Select Case Asc(Mid(Txt, i, 1))
Case 65 To 90
ExtractCap = ExtractCap & Mid(Txt, i, 1)
End Select
Next
End Function
while, should the pattern of your data strictly be as you showed, you could also consider:
Function ExtractCap(Txt As String) As String
Application.Volatile
ExtractCap = "UA" & Split(Txt, ":")(3)
End Function
Your RegEx works like this:
Function ExtractCap(Txt As String) As String
Application.Volatile
Dim xRegEx As Object
Set xRegEx = CreateObject("VBScript.RegExp")
With xRegEx
.Pattern = "[^A-Z]"
.Global = True
.MultiLine = False
ExtractCap = .Replace(Txt, vbNullString)
End With
If Txt = ExtractCap Then ExtractCap = "1WO"
End Function
Public Sub TestMe()
Debug.Print ExtractCap("User:399595:Account:ETH:balance")
End Sub
In your code, there were 2 errors, which stopped the execution:
xRegEx was set to Nothing and then it was asked to provide a value;
the check If xRegEx.Pattern = "[^A-Z]" does not actually mean a lot to VBA. E.g., you are setting a Pattern and making a condition out of it. If you want to know whether a pattern exists in a RegEx, you should compare the two strings - before and after the execution of the pattern.
Your problem can be easily solved.
Firstly, I assumed that 1WO can appears at most once in your string.
Based on that assumption, logic is as follows:
Define function, which extracts all capital letters from strings.
Now, in the main function, you split your string first using 1WO as delimeter. Now, pass every string (after splitting) to function, get all the caps from those strings and concatenate them again with 1WO in its place.
Option Explicit
Public Function Extract(str As String) As String
Dim s As Variant
For Each s In Split(str, "1WO")
'append extracted caps with 1WO at the end
Extract = Extract & ExtractCaps(s) & "1WO"
Next
'delete lest 1WO from result
Extract = Left(Extract, Len(Extract) - 3)
End Function
Function ExtractCaps(str As Variant) As String
Dim i As Long, char As String
For i = 1 To Len(str)
char = Mid(str, i, 1)
If Asc(char) > 64 And Asc(char) < 91 And char = UCase(char) Then
ExtractCaps = ExtractCaps & char
End If
Next
End Function
If you put this code in inserted Module, you can use it in a worksheet in formula: =Extract(A1).
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):#.
I have this code, but when I use this, the UrlTest variable return the entire URL and not the capturing groups where I have defined in the regex. ^http:\/\/myanimelist\.net\/animelist\/(.*[^\/])(?:\/|)$
Here is my code:
Private Function UrlTest(strUrl As String) As String
'Do the regEx for get the user in url
Dim regEx As New RegExp
regEx.Pattern = "^http:\/\/myanimelist\.net\/animelist\/(.*[^\/])(?:\/|)$"
regEx.IgnoreCase = True
regEx.Global = False
If regEx.Test(strUrl) Then
Dim matche As Object
Set matche = regEx.Execute(strUrl)
If matche.Count <> 0 Then
UrlTest = matche(0)
End If
Else
UrlTest = "false"
End If
End Function
This function with strUrl with http://myanimelist.net/animelist/example as value return the same value, and not what I want: example.
I can't understand that ! You can see, this Regex test work !
UrlTest = matche(0).submatches(0)
You should try this.
I have a function that was written so that VBA can be used in MS Access
I wish to do the following
I have set up my code below. Everything before the product works perfectly but trying to get the information behind just returns "" which is strange as when i execute it within Notepad++ it works perfectly fine
So it looks for the letters MIP and one of the 3 letter codes (any of them)
StringToCheck = "MADHUBESOMIPTDTLTRCOYORGLEJ"
' PART 1
' If MIP appears in the string, then delete any of the following codes if they exist - DOM, DOX, DDI, ECX, LOW, WPX, SDX, DD6, DES, BDX, CMX,
' WMX, TDX, TDT, BSA, EPA, EPP, ACP, ACA, ACE, ACS, GMB, MAL, USP, NWP.
' EXAMPLE 1. Flagged as: MADHUBESOMIPTDTLTRCOYORGLEJ, should be MADHUBESOMIPLTRCOYORGLEJ
Do While regexp(StringToCheck, "MIP(DOM|DOX|DDI|ECX|LOW|WPX|SDX|DD6|DES|BDX|CMX|WMX|TDX|TDT|BSA|EPA|EPP|ACP|ACA|ACE|ACS|GMB|MAL|USP|NWP|BBX)", False) <> ""
' SELECT EVERYTHING BEFORE THE THREE LETTER CODES
strPart1 = regexp(StringToCheck, ".*^[^_]+(?=DOM|DOX|DDI|ECX|LOW|WPX|SDX|DD6|DES|BDX|CMX|WMX|TDX|TDT|BSA|EPA|EPP|ACP|ACA|ACE|ACS|GMB|MAL|USP|NWP|BBX)", False)
' SELECT EVERYTHING AFTER THE THREE LETTER CODES
strPart2 = regexp(StringToCheck, "(?<=(DOM|DOX|DDI|ECX|LOW|WPX|SDX|DD6|DES|BDX|CMX|WMX|TDX|TDT|BSA|EPA|EPP|ACP|ACA|ACE|ACS|GMB|MAL|USP|NWP|BBX).*", False)
StringToCheck = strPart1 & strPart2
Loop
The function i am using which i have taken from the internet is below
Function regexp(StringToCheck As Variant, PatternToUse As String, Optional CaseSensitive As Boolean = True) As String
On Error GoTo RefErr:
Dim re As New regexp
re.Pattern = PatternToUse
re.Global = False
re.IgnoreCase = Not CaseSensitive
Dim m
For Each m In re.Execute(StringToCheck)
regexp = UCase(m.Value)
Next
RefErr:
On Error Resume Next
End Function
Just do it in two steps:
Check if MIP is in the string
If it is, remove the other codes.
Like this:
Sub Test()
Dim StringToCheck As String
StringToCheck = "MADHUBESOMIPTDTLTRCOYORGLEJ"
Debug.Print StringToCheck
Debug.Print CleanupString(StringToCheck)
End Sub
Function CleanupString(str As String) As String
Dim reCheck As New RegExp
Dim reCodes As New RegExp
reCheck.Pattern = "^(?:...)*?MIP"
reCodes.Pattern = "^((?:...)*?)(?:DOM|DOX|DDI|ECX|LOW|WPX|SDX|DD6|DES|BDX|CMX|WMX|TDX|TDT|BSA|EPA|EPP|ACP|ACA|ACE|ACS|GMB|MAL|USP|NWP|BBX)"
reCodes.Global = True
If reCheck.Test(str) Then
While reCodes.Test(str)
str = reCodes.Replace(str, "$1")
Wend
End If
CleanupString = str
End Function
Note that the purpose of (?:...)*? is to group the letters in threes.
Since the VBScript regular expression engine does support look-aheads, you can of course also do it in a single regex:
Function CleanupString(str As String) As String
Dim reClean As New RegExp
reClean.Pattern = "^(?=(?:...)*?MIP)((?:...)*?)(?:DOM|DOX|DDI|ECX|LOW|WPX|SDX|DD6|DES|BDX|CMX|WMX|TDX|TDT|BSA|EPA|EPP|ACP|ACA|ACE|ACS|GMB|MAL|USP|NWP|BBX)"
While reClean.Test(str)
str = reClean.Replace(str, "$1")
Wend
CleanupString = str
End Function
Personally, I like the two-step check/remove pattern better because it is a lot more obvious and therefore more maintainable.
Non RE option:
Function DeMIPString(StringToCheck As String) As String
If Not InStr(StringToCheck, "MIP") Then
DeMIPString = StringToCheck
Else
Dim i As Long
For i = 1 To Len(StringToCheck) Step 3
Select Case Mid$(StringToCheck, i, 3)
Case "MIP", "DOM", "DOX", "DDI", "ECX", "LOW", "WPX", "SDX", "DD6", "DES", "BDX", "CMX", "WMX", "TDX", "TDT", "BSA", "EPA", "EPP", "ACP", "ACA", "ACE", "ACS", "GMB", "MAL", "USP", "NWP":
Case Else
DeMIPString = DeMIPString & Mid$(StringToCheck, i, 3)
End Select
Next
End If
End Function