I am new to vb.script so this may just be a formatting question that I cannot find the answer.
The problem is validating data in cells that are on different sheets in the same workbook.
Looping through worksheets and then looping through the cell range:
Private Sub Validate(ByRef objWorkbook As Workbook)
Dim strPattern As String: strPattern = "^\-{0,1}\d+(.\d+){0,1}$"
Dim regEx As New VBScript_RegExp_55.RegExp
Dim strInput As String
Dim strOutput As String
Dim Myrange As Range
Dim regExCount As Object
Set regExCount = CreateObject("vbscript.regexp")
On Error Resume Next
For Each objWorksheet In objWorkbook.Worksheets
If (UCase(objWorksheet.Name) = "Foo") Then
objWorksheet.Select
Range("Q2").Select
ElseIf (UCase(objWorksheet.Name) = "Bar") Or (UCase(objWorksheet.Name) = "Poo") Then
objWorksheet.Select
Set Myrange = ActiveSheet.Range("D51:AA76")
For Each cell In Myrange.Cells
If strPattern <> "" Then
strInput = cell.Value
strReplace = ""
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
Set regExCount = regEx.Execute(strInput)
If regExCount.Count = 0 Then
strOutput = strOutput + "Illegal character at " + cell.AddressLocal + "\r\n"
End If
Next cell
End If
Next
MsgBox (strOutput)
End Sub
When I compile I get an error of a Next without a For loop at the Next Cell. Removing that line and I get an error for Block If without an End Ff highlighting the End Sub. Adding an End If before the End sub and I get a Next without a For error.
Isn't it this block missing and end if?
If strPattern <> "" Then
strInput = cell.Value
strReplace = ""
Your
If strPattern <> "" Then
is not closed between
End If ' regExCount.Count
Next cell ' In Myrange.Cells
Related
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 6 months ago.
Improve this question
excel value=M#9094562;M 0567468;M25969028;M25969029;Mployee e
Function simpleCellRegex(Myrange As Range) As String
Dim regEx As New RegExp
Dim strPattern As String
Dim strInput As String
Dim strReplace As String
Dim strOutput As String
strPattern = "m[0-9]{8}"
If strPattern <> "" Then
strInput = Myrange.Value
strReplace = ""
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = strPattern
End With
If regEx.Test(strInput) Then
simpleCellRegex = regEx.Replace(strInput, strReplace)
Else
simpleCellRegex = "Not matched"
End If
End If
End Function
Use a regex tester to check what you are getting. https://regexr.com/
Your current Regex only matches 2 occurrences in your pattern.
The others contain a space and a hash, and one only has 7 digits. If you want to find these as well you can expand your pattern.
m.?[0-9]{7,8}
But, if you truly want M followed by 8 digits (M12345678) then your pattern works.
Your Excel code is wrong... you are not looping through the matches (see below):
If regEx.Test(strInput) Then
simpleCellRegex = regEx.Replace(strInput, strReplace)
Else
You need to loop through the matches in the string (see below):
Function simpleCellRegex(Myrange As Range) As String
Dim regEx As New RegExp
Dim strPattern As String
Dim strInput As String
'Added to store matches
Dim objRegMC As Object
Dim objRegM As Object
Dim intCounter As Integer
Dim strDelimiter As String
intCounter = 1
strDelimiter = "|"
strPattern = "m[0-9]{8}"
If strPattern <> "" Then
strInput = Myrange.Value
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = strPattern
End With
If regEx.Test(strInput) Then
'Store matched string and loop through matches
Set objRegMC = regEx.Execute(strInput)
For Each objRegM In objRegMC
'Do what you want here to split values etc.
'I have added a delimiter, you can do whatever you want
If objRegMC.Count > 1 Then
If intCounter = objRegMC.Count Then
simpleCellRegex = simpleCellRegex & objRegM
Else
simpleCellRegex = simpleCellRegex & objRegM & strDelimiter
End If
intCounter = intCounter + 1
Else
simpleCellRegex = objRegM
End If
Next
Else
simpleCellRegex = "Not matched"
End If
End If
End Function
Results below:
writing macro to extract IP out of many cells and buried in text. I need to find the IP and then copy each to a new blank cell.
I get the results "not matched". Please advise as I'm over thinking this.
To test I filled 40 cells with "this is a ip test 8.8.8.8 oh no"
Private Sub simpleRegex()
Dim strPattern As String: strPattern = "\b(?:[0-9]{1,3}\.){3}[0-9]{1,3}\b" 'find IP
Dim Match As Object
Dim matches As Object
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
Dim strInput As String
Dim Myrange As Range
Set Myrange = ActiveSheet.Range("A1:A39") 'within this range
Dim i As Long, strMatches As String
i = 1 'row number where we start to write
For Each cell In Myrange
If strPattern <> "" Then
strInput = cell.Value
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regex.Test(strInput) Then 'if ip found do this
Set matches = regex.Execute(strInput)
strMatches = vbNullString
For Each Match In matches
'strMatches = strMatches 'collect all matches ip?
Worksheets("Sheet1").Range("U" & i).Value = strMatches 'write the matches into cell
i = i + 1
Next
Else
MsgBox ("Not matched")
End If
End If
Next
End Sub
This works for me (re-arranged the output a bit)
Private Sub simpleRegex()
Dim strPattern As String:
Dim Match As Object
Dim matches As Object
Dim strMatches As String
Dim regex As Object
Dim strInput As String
Dim Myrange As Range, cell As Range, cOut as Range
Set regex = CreateObject("VBScript.RegExp")
strPattern = "\b(?:[0-9]{1,3}\.){3}[0-9]{1,3}\b" 'find IP
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
Set cOut = ActiveWorkbook.Worksheets("Sheet2").Range("A1") 'start output here
Set Myrange = ActiveSheet.Range("A1:A39") 'within this range
For Each cell In Myrange
strInput = cell.Value
If Len(strInput) > 0 Then
If regex.Test(strInput) Then 'if ip found do this
Set matches = regex.Execute(strInput)
strMatches = vbNullString
For Each Match In matches
cOut.Value = Match.Value 'write the match into cell
Set cOut = cOut.Offset(1, 0)'next cell down
Next
Else
'cell.Offset(0, 1).Value = "No matches"
End If
End If
Next
End Sub
I am trying to use VBA to loop through and find all dates within a textbox, regardless of format. I think I have my regex working. However, when trying to populate a combo box I am having difficulty.
Maybe my code is a bit messy and I am doing it the wrong way. Wha What I mean by that is it's putting every word in the combo box instead of just dates.
However, here is my code
Private Sub CommandButton2_Click()
Call dates1
End Sub
Function ExtractDates(S As String)
With CreateObject("VBScript.RegExp")
.Pattern = .Pattern = "^(?:(?:31(\/|-|\.)(?:0?[13578]|1[02]))\1|(?:(?:29|30)(\/|-|\.)(?:0?[13-9]|1[0-2])\2))(?:(?:1[6-9]|[2-9]\d)?\d{2})$|^(?:29(\/|-|\.)0?2\3(?:(?:(?:1[6-9]|[2-9]\d)?(?:0[48]|[2468][048]|[13579][26])|(?:(?:16|[2468][048]|[3579][26])00))))$|^(?:0?[1-9]|1\d|2[0-8])(\/|-|\.)(?:(?:0?[1-9])|(?:1[0-2]))\4(?:(?:1[6-9]|[2-9]\d)?\d{2})$"
.Global = True
ExtractDates = Replace(Trim(.Replace(S, " $1")), " ", ", ")
End With
End Function
Sub dates1()
Dim dates1 As String
Dim dates2 As String
dates2 = ExtractDates(Me.txtS.Text)
Dim optarray
Dim opt
optarray = Split(dates2, ",")
With Me.ComboBox1
.Clear
For opt = 0 To UBound(optarray)
.AddItem (optarray(opt))
Next opt
End With
End Sub
I managed to do this if anyone else is interested:
Option Explicit
Private Sub CommandButton1_Click()
CountDates (Me.TextBox1.Text)
End Sub
Function CountDates(S As String) As Long
Dim i As Integer
Dim result As String
Dim RE As Object, MC As Object
Const sPat As String = "\b(?:\d{1,2}/){2}(?:\d{4}|\d{2})\b"
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = sPat
.Global = True
Set MC = .Execute(S)
CountDates = MC.Count
CountDates = CountDates - 1
If MC.Count <> 0 Then
For i = 0 To CountDates
Me.ComboBox1.AddItem (MC.Item(i))
Next i
End If
End With
End Function
I'm trying to setup a function for Regex which returns a cell.address. It's 99% working except it seems to return the value of the cell test vs the cell location and I can't figure it out.
Debugging:
It says Object variable or with block variable not set if I Dim celladdr As Range
but if I comment that out, then the error changes to Object doesn't support this property or method and I can see that celladdr = test.
I then tried Set celladdr = Range(celladdr.Address) and get Object Required.
Can anybody point out the error?
Here is some stripped down code:
Note, I hardcoded the RegEx pattern as that function works as expected, the problem seems to be in the RegExSearch function, but I can add more code back in if needed.
Public Sub TESTING()
Dim celladdr As Range
celladdr = RegExFunc("TEST")
ActiveSheet.celladdr.Select
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function RegExFunc(var) As Variant
RegExSearchPattern = RegExPattern(var)
RegExFunc = RegExSearch(RegExSearchPattern)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function RegExPattern(my_string) As Variant
RegExPattern = "([a-z]{4})"
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function RegExSearch(strPattern) As Range
Dim regexp As Object
Dim rcell As Range, rng As Range
Dim strInput As String
Set regexp = CreateObject("vbscript.regexp")
Set rng = Range("A1:Z255")
For Each rcell In rng.Cells
If rcell <> "" Then
If strPattern <> "" Then
strInput = rcell.Value
With regexp
.Global = False
.MultiLine = False
.ignoreCase = True
.Pattern = strPattern
End With
If regexp.Test(strInput) Then
MsgBox rcell & " Matched in Cell" & rcell.Address
Set RegExSearch = Range(rcell.Address)
MsgBox RegExSearch
End If
End If
End If
Next
End Function
There were various instances in which you needed to Set the object and one in which a Dim was needed. Since you declared almost everything a Variant, it makes it a bit harder to pinpoint the breakdown. It's best, in my experience to always specifically declare the variables in VBA.
I ran the following adjusted code (added a few sets as noted above) and it worked without any decompile or run time errors.
Public Sub TESTING()
Dim celladdr As Range
Set celladdr = RegExFunc("TEST")
celladdr.Select
End Sub
Public Function RegExFunc(var As String) As Range
Dim RegExSearchPattern As String
RegExSearchPattern = RegExPattern(var)
Set RegExFunc = RegExSearch(RegExSearchPattern)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function RegExPattern(my_string As String) As String
RegExPattern = "([a-z]{4})"
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function RegExSearch(strPattern As String) As Range
Dim regexp As Object
Dim rcell As Range, rng As Range
Dim strInput As String
Set regexp = CreateObject("vbscript.regexp")
Set rng = Range("A1:Z255")
For Each rcell In rng.Cells
If rcell <> "" Then
If strPattern <> "" Then
strInput = rcell.Value
With regexp
.Global = False
.MultiLine = False
.ignoreCase = True
.Pattern = strPattern
End With
If regexp.Test(strInput) Then
MsgBox rcell & " Matched in Cell" & rcell.Address
Set RegExSearch = Range(rcell.Address)
MsgBox RegExSearch
End If
End If
End If
Next
End Function
A cell address is just a string; you don't Set it, simply assign it with =.
RegExSearch = rcell.Address
... will return the absolute cell address.
You might want to consider exiting the For Each rcell In rng.Cells loop if the pattern is found. There doesn't seem to be any point in continuing unless you want the cell addresses of the union of all matching cells.
If regexp.Test(strInput) Then
MsgBox rcell & " Matched in Cell" & rcell.Address
RegExSearch = rcell.Address
MsgBox RegExSearch
Exit For
End If
You're setting identical RegEx arguments inside the loop. Move the argument assignment above the For Each rcell In rng.Cells loop.
With regexp
.Global = False
.MultiLine = False
.ignoreCase = True
.Pattern = strPattern
End With
For Each rcell In rng.Cells
I would like to find the "strPattern" string below, but use REPLACE to replace only "strPattern1" - which is effectively "strPattern" excluding the last character.
Dim strPattern As String: strPattern = "^\d{1,2}.\d{1,2}\s\OS\s[MCVH]"
Dim strPattern1 As String: strPattern1 = "^\d{1,2}.\d{1,2}\s\OS"
Dim strReplace As String: strReplace = ""
Dim regEx As New RegExp
Dim strInput As String
Dim Myrange As Range
Set Myrange = ActiveSheet.Range("B1", Range("b1").End(xlDown))
For Each cell In Myrange
If strPattern <> "" Then
strInput = cell.Value
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.test(strInput) Then
cell.Offset(0, 0) = regEx.Replace(strInput, strReplace)
End If
End If
Next
Thank you in advance for your help
You need to use fields in your search string '()'. e.g. "(^\d{1,2}.\d{1,2}\s\OS\s)([MCVH])". Your replace string would be "$2".