I'm able to find and replace the special characters in a string but I'm trying to return that special character. Here's what i got so far.
Function replaceSpecialCharacter(theString As String)
Dim StrTest As String
Dim Result As String
Dim Reg1 As Object
Dim matches
StrTest = theString
Set Reg1 = CreateObject("VBScript.RegExp")
With Reg1
.Global = True
.IgnoreCase = True
.Pattern = "[-[\]{}()%*+?\\/^$|#\s]" ' escape special characters pattern
End With
If Reg1.test(StrTest) Then
Result = Reg1.Replace(StrTest, Result)
End If
replaceSpecialCharacter = Result
End Function
If there is only 1 match and you want to return it, you can use a matches object, returned by the Execute method of the regulat expression object:
Function findSpecialCharacter(theString As String)
Dim StrTest As String
Dim Result As String
Dim Reg1 As Object
Dim matches As Object
StrTest = theString
Set Reg1 = CreateObject("VBScript.RegExp")
With Reg1
.Global = True
.IgnoreCase = True
.Pattern = "[-[\]{}()%*+?\\/^$|#\s]" ' escape special characters pattern
End With
Set matches = Reg1.Execute(theString)
findSpecialCharacter = matches(0).Value 'assumes just 1 match, at index 0
End Function
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:
I have a list of items:
B100Q91, B75NX2, BR100, XN20ZN..
I want to remove the first set of numbers in every item, so that it looks like this:
BQ91, BNX2, BR, XNZN..
My approach looks like this:
Function RemoveFirstNumbers(Txt As String) As String
With CreateObject("VBScript.RegExp")
Dim posn As Integer
posn = GetPositionOfFirstNumericCharacter(Txt)
1
If (IsError(posn)) = True Then Replace(Txt, 1, 1) As String
Dim posn As Integer
Else
End With
End Function
End If
GoTo 1
with
Public Function GetPositionOfFirstNumericCharacter(ByVal s As String) As Integer
Dim i As Integer
For i = 1 To Len(s)
Dim currentCharacter As String
currentCharacter = Mid(s, i, 1)
If IsNumeric(currentCharacter) = True Then
GetPositionOfFirstNumericCharacter = i
Exit Function
End If
Next i
End Function
EDIT to package the below as a function
Function ReplaceFirstDigits(sLookupExpression) as String
Dim oReg As Object
Set oReg = CreateObject("VBScript.Regexp")
With oReg
.Global = True
.ignorecase = True
.MultiLine = False
.Pattern = "([A-Za-z]+)(\d+)(\w*)"
End With
ReplaceFirstDigits = oReg.Replace(sLookupExpression, "$1$3")
End Function
Then you can call the function directly from the spreadsheet with a standard syntax, such as =ReplaceFirstDigits(A1)
If you wanted to use a regular expression, code such as the following might do the trick for you.
Sub Test()
Dim oReg As Object
Set oReg = CreateObject("VBScript.Regexp")
With oReg
.Global = True
.ignorecase = True
.MultiLine = False
.Pattern = "([A-Za-z]+)(\d+)(\w*)"
End With
Debug.Print oReg.Replace(Selection, "$1$3")
End Sub
EDITED:
If you don't want to use RegExp, just straight VBA:
Option Explicit
Function RemoveFirstNumber(strInput As String) As String
Dim strRet As String
Dim bFirstNumber As Boolean
bFirstNumber = False
Dim strChar As String
Dim nChar As Integer
For nChar = 1 To Len(strInput)
strChar = Mid(strInput, nChar, 1)
If IsNumeric(strChar) Then
bFirstNumber = True
Else
If bFirstNumber Then
strRet = strRet & Mid(strInput, nChar)
Exit For
End If
strRet = strRet & strChar
End If
Next nChar
RemoveFirstNumber = strRet
End Function
I have the below code
Function simpleCellRegex(Myrange As Range) As String
Set regEx = CreateObject("VBScript.RegExp")
'Dim regEx As New RegExp
Dim strPattern As String
Dim strInput As String
Dim strReplace As String
Dim strOutput As String
strPattern = "_[a-zA-Z][0-9]"
If strPattern <> "" Then
strInput = Myrange.Value
strReplace = "_"
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.test(strInput) Then
simpleCellRegex = regEx.Replace(strInput, strReplace)
Else
simpleCellRegex = "Not matched"
End If
End If
End Function
Right now, the strReplace variable is hard-coded. Is there a way to replace the matched substring with the same substring without letters?
Ie.,
If the Input is
"bs_oper36_a01"
I would like to output
"bs_oper36_01". However the last several characters could change, so would it be possible to make the output dynamic, ie., if the input changes?
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".
I found an old post regarding a sentence case function at the following link.
Converting to sentence case using vba
I happen to love the following function designed by bretdj
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
MsgBox strIn
End With
What i can't figure out is how to make the function to sentence case the string typed in a particular cell and then put the corrected sentence back into the original cell. I don't need it in a message box. Something similar to the following:
If Not Intersect(Target, myrange2) Is Nothing Then
Target.Value = ProperCaps(Target.Value)
End If
Any help would be appreciated. Forgive me for reposting this, I'm not authorized to comment on posts.
Thanks
Gary
Your function is missing the last part, but if the last part is just one more line End Function then all you need to do is replace MsgBox strIn with ProperCaps = strIn:
Option Explicit
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
End With
ProperCaps = strIn
End Function