There's a table named sample including only one column, body (type: text) in ms access 2010:
<name>John</name><age>12</age>
I'd like to delete every string inside the brackets. See this:
John12
I added Microsoft VBScript Regular Expression 5.5 library and create this module:
Function Replace_Regex(str1, patrn, replStr)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = True
Replace_Regex = regEx.Replace(str1, replStr)
End Function
And then, I run this query:
update sample
set body = Replace_Regex(body, "<[^>]+?", "")
But the result is:
ame>John</name><age>12</age>
So, what's the problem?
Add this to the function:
regEx.Global = True
Then use "<[^>]*>" as the pattern.
Here's what I get in the Immediate window:
body = "<name>John</name><age>12</age>"
? Replace_Regex(body, "<[^>]*>", "")
John12
Related
I'm trying to duplicate a sheet. The user inputs the sheet name with an Input Box.
I'm trying to figure out how to interrupt the process if the user inputs a sheet name that already exists.
My plan is to use RegEx to match the string against all of the sheets in the workbook, and determine if the inputted name is already in use.
Here is my current code:
Dim NewSheetName As String
SheetInput: NewSheetName = InputBox("Insert the new sheet name.")
'Ends procedure if user does not input anything.
If NewSheetName = "" Then
Exit Sub
End If
'Ends procedure if the sheet name is already in use.
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Pattern = NewSheetName
End With
For i = 1 To Sheets.Count
If RegEx.Test(Sheet(i).Name) = False Then
MsgBox ("This name is already used on a different sheet. Please use a different name.")
GoTo SheetInput
End If
Next i
I get the message
"Compile Error: Sub or Function not defined"
with Sheet in Sheet(i).Name highlighted. I assumed the name of the sheet would be inputted into the RegEx function as a string, but this doesn't seem to be happening.
There are many ways to check if a sheet exists. Here is one. I am sure there may be better ones.
Public Function worksheetExists(ByVal wb As Workbook, ByVal sheetNameStr As String) As Boolean
On Error Resume Next
worksheetExists = (wb.Worksheets(sheetNameStr).Name <> "")
On Error GoTo 0
End Function
Here are a couple of ways to call this function:
If worksheetExists(ThisWorkbook, "sheetNameOne") then ...
If Not worksheetExists(ThisWorkbook, "sheetNameOne") then ...
Adding a call to a couple of user defined functions that are reusable, and restructuring your code to use a Do Loop instead of GoTo see the following:
Public Sub AddNewWrkSht()
Dim SheetName As String
SheetName = GetValidSheetName()
Dim NewWrkSht As Worksheet
Set NewWrkSht = ThisWorkbook.Worksheets.Add
NewWrkSht.Name = SheetName
End Sub
Private Function GetValidSheetName() As String
Dim NewSheetName As String
'keep asking the user for a valid sheet name
'until it is valid
Do
NewSheetName = InputBox("Insert the new sheet name.")
Loop Until IsValidSheetName(NewSheetName)
GetValidSheetName = NewSheetName
End Function
Private Function IsValidSheetName(ByVal SheetName As String) As Boolean
If IsValueEmpty(SheetName) Then
MsgBox "You must Provide a sheet Name."
Exit Function
End If
If WorkSheetExists(SheetName) Then
MsgBox "This name is already used on a different sheet. " & _
"Please choose a different name."
Exit Function
End If
'if we make it here without exiting, then the sheet name is valid
IsValidSheetName = True
End Function
Private Function WorkSheetExists(ByVal SheetName As String) As Boolean
On Error Resume Next
WorkSheetExists = Not ActiveWorkbook.Worksheets(SheetName) Is Nothing
End Function
Private Function IsValueEmpty(ByVal varValue As Variant) As Boolean
IsValueEmpty = (Len(RemoveAllWhiteSpace(varValue)) = 0)
End Function
Private Function RemoveAllWhiteSpace(ByRef varStringIn As Variant, _
Optional ByRef RegExpIn As Object) As String
'Create if not instantiated
If RegExpIn Is Nothing Then Set RegExpIn = CreateObject("VBScript.RegExp")
With RegExpIn
.Pattern = "\s"
.MultiLine = True
.Global = True
RemoveAllWhiteSpace = CStr(.Replace(varStringIn, vbNullString))
End With
End Function
I have a system that I can output a spreadsheet from. I then take this outputted spreadsheet and import it into MS Access. There, I run some basic update queries before merging the final result into a SharePoint 2013 Linked List.
The spreadsheet I output has an unfortunate Long Text field which has some comments in it, which are vital. On the system that hosts the spreadsheet, these comments are nicely formatted. When the spreadsheet it output though, the field turns into a long, very unpretty string like so:
09:00 on 01/03/2017, Firstname Surname. :- Have responded to request for more information. 15:12 on 15/02/2017, Firstname Surname. :- Need more information to progress request. 17:09 on 09/02/2017, Firstname Surname. :- Have placed request.
What I would like to do is run a query (either in MS Access or MS Excel) which can scan this field, detect occurrences of "##:## on ##/##/####, Firstname Surname. :-" and then automatically insert a line break before them, so this text is more neatly formatted. It would obviously skip the first occurrence of this format, as otherwise it would enter a new line at the start of the field. Ideal end result would be:
09:00 on 01/03/2017, Firstname Surname. :- Have responded to request
for more information.
15:12 on 15/02/2017, Firstname Surname. :- Need more information to progress request.
17:09 on 09/02/2017, Firstname Surname. :- Have placed request.
To be honest, I haven't tried much myself so far, as I really don't know where to start. I don't know if this can be done without regular expressions, or within a simple query versus VBA code.
I did start building a regular expression, like so:
[0-9]{2}:[0-9]{2}\s[o][n]\s[0-9]{2}\/[0-9]{2}\/[0-9]{4}\,\s
But this looks a little ridiculous and I'm fairly certain I'm going about it in a very unnecessary way. From what I can see from the text, detecting the next occurrence of "##:## on ##/##/####" should be enough. If I take a new line after this, that will suffice.
You have your RegExp pattern, now you need to create a function to append found items with your extra delimiter.
look at this function. It takes, your long string and finds your date-stamp using your pattern and appends with your delimiter.
Ideally, i would run each line twice and add delimiters after each column so you have a string like,
datestamp;firstname lastname;comment
you can then use arr = vba.split(text, ";") to get your data into an array and use it as
date-stamp = arr(0)
name = arr(1)
comment = arr(2)
Public Function FN_REGEX_REPLACE(iText As String, iPattern As String, iDelimiter As String) As String
Dim objRegex As Object
Dim allmatches As Variant
Dim I As Long
On Error GoTo FN_REGEX_REPLACE_Error
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Multiline = True
.Global = True
.IgnoreCase = True
.Pattern = iPattern
If .test(iText) Then
Set allmatches = .Execute(iText)
If allmatches.count > 0 Then
For I = 1 To allmatches.count - 1 ' for i = 0 to count will start from first match
iText = VBA.Replace(iText, allmatches.item(I), iDelimiter & allmatches.item(I))
Next I
End If
End If
End With
FN_REGEX_REPLACE = Trim(iText)
Set objRegex = Nothing
On Error GoTo 0
Exit Function
FN_REGEX_REPLACE_Error:
MsgBox Err.description
End Function
use above function as
mPattern = "[0-9]{2}:[0-9]{2}\s[o][n]\s[0-9]{2}\/[0-9]{2}\/[0-9]{4}\,"
replacedText = FN_REGEX_REPLACE(originalText,mPattern,vbnewline)
Excel uses LF for linebreaks, Access uses CRLF.
So it should suffice to run a simple replacement query:
UPDATE myTable
SET LongTextField = Replace([LongTextField], Chr(10), Chr(13) & Chr(10))
WHERE <...>
You need to make sure that this runs only once on newly imported records, not repeatedly on all records.
Using Excel 2010. I want to only allow values in a cell that fit a given regex pattern. So I created a UDF module as follows:
Public re as RegExp
Public Function isValidRegex(rng As Range, pattern As String) As Boolean
If re Is Nothing Then
Set re = New RegExp
End If
re.pattern = pattern
isValidRegex = re.Test(rng.value)
End Function
I created a named range called THIS_CELL, so that the current cell can be passed to isValidRegex(), as follows:
=INDIRECT(ADDRESS(ROW(),COLUMN()))
I set a custom validation for the cell, using this formula:
=isValidRegex(THIS_CELL,"(my|regex)patt[ern]")
This generated the following error:
A named range you specified cannot be found.
According to this article, UDFs cannot be used in Custom validation formulas. The solution suggested in the article (putting the formula in another cell, making that cell into a named range, and referencing that cell in the Custom formula) won't work, because I need to be able to pass THIS_CELL as an argument to the function.
I also tried creating a named range called isValidRegexPattern, defining it as =isValidRegex(THIS_CELL,"(my|regex)patt[ern]"), and setting the Custom formula to =isValidRegexPattern, but this didn't work either; putting a breakpoint in isValidRegex() showed that the function wasn't even being called.
So, how can I use a UDF for cell validation?
You can use a static variable with the Worksheet_Change event to keep a snapshot of the prior values
The code below tracks the values in A1:A10 and uses a Regexp like yours to reject any non-numeric entries
The example below tries top copy and paste B1:B10 over A1:A10, only A6and A8 are allowed as they are numeric
to set the range initially change a cell outside the range of interest to trigger If IsEmpty(X) Then X = [a1:a10].Value2
change event
Private Sub Worksheet_Change(ByVal Target As Range)
Static X As Variant
Dim rng2 As Range
Dim rng3 As Range
If IsEmpty(X) Then X = [a1:a10].Value2
Set rng2 = Intersect([a1:a10], Target)
If rng2 Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rng3 In rng2
If Not isValidRegex(rng3, "\d+") Then rng3.Value = X(rng3.Row, 1)
Next
Application.EnableEvents = True
X = [a1:a10].Value2
End Sub
regexp
Function isValidRegex(rng As Range, pattern As String) As Boolean
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.pattern = pattern
isValidRegex = re.Test(rng.Value)
End Function
You seem to be reluctant to move over to a WorksheetChange event macro because you believe it does not 'capture the pre-change state of the cell'. That may be correct in the strictest definition but that doesn't mean you cannot capture the changed state, undo the change, determine whether the change is valid and only re-apply the change if it meets criteria.
I'm not going to produce a full regex validating function. This simply tests if the number typed into column E is less than zero or blank. If not then the cell reverts to its prechange state.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns(5)) Is Nothing Then
If Not IsEmpty(Target) Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim vNEW As Variant
vNEW = Target.Value
Application.Undo
If bIs_It_Valid(vNEW) Then
Target = vNEW
Else
' put stuff like idiot warnings here
End If
End If
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Private Function bIs_It_Valid(val As Variant) As Boolean
If IsNumeric(val) Then _
bIs_It_Valid = CBool(val < 0)
Debug.Print bIs_It_Valid
End Function
That Worksheet_Change could probably be adjusted to work on a range of cells if pasting a number of values is important.
Here's how I accomplished this without using the Worksheet_Change event
Define a Public REGEX Function in a new Module
'Public REGEX Formula
Public Function REGEX(pattern As String, cel As Range) As Boolean
Dim re As New RegExp
re.pattern = pattern
REGEX = re.Test(cel.Value)
End Function
I added this Sub to a module I named Validations. This Sub requires not only the range to validate and the regular expression pattern, but also another range to apply the REGEX formula to. The actual validation applied actually only checks that separate cell for a True or False value. This is a simplified version that assumes the validationColumn is an entire column.
'Validations Module
Sub regexValidation(cells As Range, pattern As String, validationColumn As Range, defaultValue As String)
Dim cel As Range, regexFormula As String, validationCell As Range
cells.Value = defaultValue
'Need to match true on default value or validation will always fail
pattern = "(" & defaultValue & ")|(" & pattern & ")"
For Each cel In cells
regexFormula = "=REGEX(""" & pattern & """," & cel.address & ")"
Set validationCell = validationColumn.cells(cel.Row, 1)
validationCell.Formula = regexFormula
cel.Validation.Delete
cel.Validation.Add xlValidateCustom, Formula1:="=" & Trim(validationCell.address)
Next cel
End Sub
This is how I'm calling it. In my case, this is a UserForm with a TextBox called regexPattern that contains the regular expression to apply.
'Form
Private Sub applyRegexValidation(cells As Range)
Validations.regexValidation cells, regexPattern.text, validationColumn:=cells.Parent.Range("AA:AA"), defaultValue:="Required Custom"
End Sub
I am using a labeling software and I don't want any text inside of parentheses to display on the labels. Here is what I have so far
Function RemovePara(TextToBeEdited)
Set myRegEx = New RegExp
myRegEx.IgnoreCase = True
myRegEx.Global = True
myRegEx.Pattern = "\(([a-z]+?)\)(.+)"
Set RemovePara = myRegEx.Replace(txt, "")
End Function
Now I'm pretty new to this, and when I try to save this code in the labeling software it says "The script did not read the "Value" property, which means the current specified data source was ignored. This may not be what you intended" I had the text I field name I want edited where "TextToBeEdited" is at. What am I missing here?
You could use lookaround assertions.
myRegEx.Pattern = "(?<=\()[^()]*(?=\))"
Set RemovePara = myRegEx.Replace(txt, "")
DEMO
I have an Asp.Net web application to manage certain tables in the database. I'm using Grid to insert, update the Database. In addition to this, the requirement is that, user should be able to insert into database from Excel(by uploading the Excel, sort of like Import from Excel into Database).
So, I'm reusing the code for insertions(which i used for Insert in Grid) for each row in the Excel.
And I have Regular expression validators for certain fieldsin Grid in Asp.Net as follows:
Id: can be combination of numbers,alphabets. Regex is:"^[a-zA-Z0-9_]{1,50}$"
Formula: can have arithmetic operators and dot. Regex is: "^[ A-Za-z0-9%._(/*+)-]*$"
Sort Order: must be nuber with some max size Regex is: "^[0-9]{1,5}$"
Weight: real number with max size Regex is : "^[0-9]+(?:\.\d{1,2})?$"
Domain UserName: username with domain name Regex is: "^[a-zA-Z\\._]{1,200}$"
I wanted to have this validators in the Excel cells too. I've searched if Excel allows Regular expressions and found that it should be done through vba or any third party tool. I don't know Vb.net and neither want to use any external tool.
And i don't know much about Excel too. Is there any way to do the validations. If so, will there be some formats for setting formula for regex.
Can anyone suggest me how to do this. Thanks In Advance.
You can use the Regex engine that comes with VBScript:
Dim User_ID As String
User_ID = InputBox("Enter User ID:")
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "^[\w]{1,50}$"
If .Test(User_ID) Then '// Check pattern matches User_ID string
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = User_ID
Else
MsgBox("Invalid ID, please try again!")
End If
End With
I got the answer. I've wrote worksheet_Change event with if else
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Row = 1 Then Exit Sub '// Only look at header row
Application.EnableEvents = False '// Disable events, prevent infinite loop.
If Cells(1, Target.Column).Value = "Attribute_Id" Then
Target.Value = AttributeId(Target.Value)
ElseIf Cells(1, Target.Column).Value = "Attribute_Name" Then
Target.Value = AttributeName(Target.Value)
End If
Application.EnableEvents = True '// Turn Events back on
End Sub
And these are the functions:
Function AttributeId(Attribute_Id As String) As String
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "^[a-zA-Z0-9_]{1,50}$"
.IgnoreCase = True
If Not .Test(Attribute_Id) Then
MsgBox ("Invalid Attribute ID, please try again!")
Exit Function
End If
End With
AttributeId = Attribute_Id
End Function
And
Function AttributeName(Attribute_Name As String) As String
If Attribute_Name = "" Then MsgBox ("Attribute Name is a Mandatory field!")
AttributeName = Attribute_Name
End Function
No need to bind the functions to the cells.
-- Thank you #S O for the help..