hi im trying to learn using regular expressions in excel vba and im wondering if someone could explain what does each line do from the code below:
update solved the first 3 lines
.Pattern = "([$()^|\\\[\]{}+*?.-])" 'solved
ptn = .Replace(r, "\$1")'solved
.Pattern = "\b" & ptn & "\b"'solved
For Each m In .Execute(r(, 4))'solved
r(, 4).Characters(m.firstindex + 1, m.Length).Font.Bold = True
Sub test()
Dim rng As Range, r As Range, m As Object, ptn As String
Columns("f").Font.Bold = False
Set rng = Range("c2", Range("c" & Rows.Count).End(xlUp))
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
For Each r In rng
If r <> "" Then
'looks for the characters inside the bracket
'including the backslash as escape for the
'literal character
.Pattern = "([$()^|\\\[\]{}+*?.-])"
'replace the found pattern with a backslash and the
'character
ptn = .Replace(r, "\$1")
'looks for the pattern as a whole word
.Pattern = "\b" & ptn & "\b"
'same as r.offset(0,3)
For Each m In .Execute(r(, 4))
r(, 4).Characters(m.firstindex + 1, m.Length).Font.Bold = True
Next
End If
Next
End With
End Sub
Related
I've been trying to come up with a macro that runs through a column and replaces the last word in a cell.
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).row
For i = 1 To LR
With Range("A" & i)
If Right(.Value, 4) = "word" Then .Value = Right(.Value, Len(.Value) + 10) & " different word"
End With
Next i
I have this code that tacks the replacement onto the end, but I don't understand it well enough to get it to replace the original.
Any input appreciated.
I like to use RegEx .Replace for situations like this. The magic here is that the dollar sign $ means "end of the line". So where I have RegEx.Pattern = "word$" that means it will only match word if it's the last thing in that line of text.
Dim LR As Long
Dim i As Long
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Global = True
RegEx.Pattern = "word$"
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With Range("A" & i)
.Value = RegEx.Replace(.Value, " different word")
End With
Next i
The goal is to get unused values in the textbox, currently i get all of them, se below
This is what I´m trying to get..
..and finally(don't know how to formulate the question yet) this..
My code so far..
It fails to recognize any matches on line 21 (If x = y Then match = True)
Option Explicit
Sub Resources()
Application.ScreenUpdating = False
Dim Arr As Variant
Arr = Range("A2:A10").Value
Dim varr As Variant
varr = Application.Transpose(ExtractNumbers(Range("C2:E10")))
ActiveSheet.TextBox1.Text = "Unused values"
Dim i As Integer
i = 1
Dim x As Variant, y As Variant, z As Variant
Dim match As Boolean
For Each x In Arr
match = False
For Each y In varr
If x = y Then match = True
Next y
If Not match And x > 0 Then
ActiveSheet.TextBox1.Text = ActiveSheet.TextBox1.Text & Chr(10) & x
End If
i = i + 1
Next
Application.ScreenUpdating = True
End Sub
Public Function ExtractNumbers(Target As Range) As Variant
Dim regEx As Object
Set regEx = CreateObject("vbscript.regexp")
Dim regExMatches As Object, regExMatch As Object
Dim Result As String
Dim Cell As Range
For Each Cell In Target
If Cell.Value <> vbNullString Then
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "[0-9]+"
End With
Set regExMatches = regEx.Execute(Cell.Value)
For Each regExMatch In regExMatches
Result = Result & regExMatch & ", "
Next regExMatch
End If
Next Cell
ExtractNumbers = Split(Left$(Result, Len(Result) - 1), ", ")
End Function
Collect the values into a vbLF delimited list before depositing them onto the worksheet.
Option Explicit
Sub resources()
Dim i As Long, str As String
With Worksheets("sheet6")
'collect the missing
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not CBool(Application.CountIf(.Range("C:E"), .Cells(i, "A").Value)) Then
str = Chr(10) & .Cells(i, "A").Value & Space(1) & .Cells(i, "B").Value & str
End If
Next i
'put results in merged cell
If CBool(Len(str)) Then
str = "unused values" & str
.Range("F:F").UnMerge
.Cells(1, "F").Resize(UBound(Split(str, Chr(10))) + 1, 1).Merge
.Cells(1, "F").WrapText = True
.Cells(1, "F") = str
End If
End With
End Sub
I have an excel file that has some cells with several text in parenthesis and outside parenthesis. I would like to split the cells. For example , I have some cells appearing like this
(some text in) parenthesis and (others outside)
I would to split the cells so that the some text in is in a different cell, parenthesis and also in a different cell and others outside also in a different cell. What I have so far only splits what's in parenthesis. Thanks in advance. Here's my code below
Sub StripCells()
Dim r As Range, i As Long
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\(([^\)]+)\)"
For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
If .test(r.Value) Then
For i = 0 To .Execute(r.Value).Count - 1
r(, i + 2).Value = "'" & .Execute(r.Value)(i).submatches(0)
Next
End If
Next
End With
End Sub
If all your cells begin with an " ( " then:
Sub fracture()
Dim r As Range, a, arr, i As Long
For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
arr = Split(Replace(r.Value, "(", ")"), ")")
i = 0
For Each a In arr
If i <> 0 Then
r.Offset(0, i).Value = a
End If
i = i + 1
Next a
Next r
End Sub
I found a pattern that works. (I cheat, and use Replace(), but it seems to do the trick):
Sub StripCells()
Dim r As Range, i As Long
With CreateObject("VBScript.RegExp")
.Global = True
'.Pattern = "\(([^\)]+)\)"
.Pattern = "((\(([^\)]+)\))|[\w+ ]+)"
For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
If .test(r.Value) Then
For i = 0 To .Execute(r.Value).Count - 1
r(, i + 2).Value = "'" & Replace(Replace(.Execute(r.Value)(i).submatches(0), ")", ""), "(", "")
Next
End If
Next
End With
End Sub
I want to find capital string from column and if available then pick first three letter and print in lower case.
Consider i have data in column like:
oracle-DATA-key --> convert it --> oracle-dat-key
key-JAVABEAN ---> convert it --> key-jav
I am able to find =NOT(EXACT(LOWER(F5),F5)) which will be true if capital value is available. but this i dont want
Like the following, which is based purely on first character in cell. Not if you are looking for any occurrence of uppercase.
=IFERROR(IF(AND(CODE(F5)<=90,CODE(F5)>=65),LOWER(LEFT(F5,3)),""),"")
A regex function to output a changed string, changing all occurrences
Public Function ReplacedString(ByVal r As Range) As String
With New RegExp
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "[A-Z][a-z]{2,}"
outputString = r.Text
If .test(outputString) Then
For Each currMatch In .Execute(r.Text)
outputString = Replace(outputString, currMatch.Value, LCase$(Left(currMatch, 3)))
Next currMatch
Else
ReplacedString = r.Text
End If
End With
ReplacedString = outputString
End Function
And looping a target column using the function:
Public Sub ReplaceStrings()
Const columnToReplaceIn = 1 'e.g. A
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'change as appropriate
Application.ScreenUpdating = False
With ws
For Each rng In Intersect(.Columns(columnToReplaceIn), .UsedRange)
rng.Value = ReplacedString(rng)
Next rng
End With
Application.ScreenUpdating = True
End Sub
Public Function ReplacedString(ByVal r As Range) As String
With New RegExp 'CreateObject("VBScript.RegExp") ''Late binding if not Microsoft vbscript regular expressions referenc
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "[A-Z][a-z]{2,}"
outputString = r.Text
If .test(outputString) Then
For Each currMatch In .Execute(r.Text)
outputString = Replace(outputString, currMatch.Value, LCase$(Left(currMatch, 3)))
Next currMatch
Else
ReplaceString = r.Text
End If
End With
ReplacedString = outputString
End Function
You have given very small data-set to test with. Here's a preliminary concept which uses RegExp
Public Function ReplaceFirstCaps(strInput As String) As String
Dim oM As Object
With CreateObject("VBScript.RegExp")
.Pattern = "[A-Z]{3,}"
If .Test(strInput) Then
Set oM = .Execute(strInput)
ReplaceFirstCaps = Replace(strInput, oM(0), LCase(Left(oM(0), 3)), , , vbBinaryCompare)
Else
ReplaceFirstCaps = strInput
End If
End With
End Function
Then use it in sheet like:
=ReplaceFirstCaps(A2)
So I have a string that looks like this:
99999999999999999999999999999FFFFFFFFFFF9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF99999^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
I am trying to count the length of the first instance of a series of a given consecutive character.
Examples:
"9" as the given char, it should count that first set of 9's and return 30.
"F" as the given char, it should return 11, for the first set of consecutive "F"s that begins after the 30 "9"s.
I"m doing this in Excel, so a formula/VBA solution is ideal. I can translate any code into VBA if necessary though. I feel like this has a Reg-Ex solution but I'm the Jon Snow of Reg-Ex, I know nothing.
Thanks in advance for any insights/advice.
I will just put this here for posterity:
=IF(SUBSTITUTE(MID($A$1,FIND(A2,$A$1),LEN($A$1)),A2,"")="",LEN($A$1)+1,FIND(MID(SUBSTITUTE(MID($A$1,FIND(A2,$A$1),LEN($A$1)),A2,""),1,1),$A$1,FIND(A2,$A$1)))-FIND(A2,$A$1)
This will count the first grouping of the desired input:
And here is a REGEX solution. Note that we have to escape the metacharacters.
Option Explicit
Function LenFirstInstance(findCHAR As String, searchSTRING As String)
Dim RE As Object, MC As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Global = False
.ignorecase = False
.Pattern = Left(findCHAR, 1) & "+"
If .Pattern Like "[\^$.|?*+()[{]*" Then _
.Pattern = "\" & .Pattern
If .Test(searchSTRING) = True Then
Set MC = .Execute(searchSTRING)
LenFirstInstance = MC(0).Length
End If
End With
End Function
Does this help? I tried it with your sample data and it seemed to work.
Function number_Appearances(ByVal myText As String, ByVal myRng As Range)
Dim cel As Range
Dim txtFound As Boolean
Dim celText$
Dim findText$
findText = myText
Set cel = myRng
celText = cel.Text
Dim celLen&
celLen = Len(celText)
txtFound = True
Dim i&, k&
Dim iChar$
For i = 1 To celLen
iChar = Mid(celText, i, 1)
If iChar = findText And txtFound = True Then
k = k + 1
ElseIf k > 0 And iChar <> findText Then
txtFound = False
End If
Next i
Debug.Print "Found " & k & " " & findText & "'s"
number_Appearances = k
End Function
But I started this before thinking of a formula. #ScottCraner's suggestion is preferable, IMO.
I got off my lazy bum and wrote VBA to solve. Thank you Scott and Bruce. And yes it was 29, not 30. Thank you again.
Public Function count_first_instance_of_consecutive_chars(the_char, the_string)
Dim counter As Integer
Dim iter As Long
Dim is_a_match As Boolean
is_a_match = False
If the_char <> vbNullString And the_string <> vbNullString Then
For iter = 1 To Len(the_string)
If Mid(the_string, iter, 1) = the_char Then
If is_a_match = True Then
counter = counter + 1
ElseIf is_a_match = False Then
is_a_match = True
counter = 1
End If
Else
If is_a_match = True Then
count_first_instance_of_consecutive_chars = counter
Exit For
End If
End If
Next iter
End If
End Function