When the contents of a cell changes, some strings are highlighted. This part I got working already. Now I added a regex to highlight strings that contain a temperature as well (ie 13° or 10°-25°) This part however does not work (no error but just no output)
This is what I have so far. This all works except for this part ( blue2Items = "(\\d{1,2}°-\\d{1,2}°|\\d{1,2}°)"
)
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J10:J80")) Is Nothing Then
Dim objRegex As Object
Dim RegMC As Object
Dim RegM As Object
'-----------------------------------------------------
Target.Font.ColorIndex = 1
redItems = "(RXB|RXG|RGX|RXC|RCX|RXD|RXE|RXS|RFG|RNG|RCL|RPG|RFL|RFS|RSC|RFW|ROX|ROP|RPB|RIS|RDS|RRW|RRY|RCM|ICE|MAG|RMD|RLI|RLM|RSB|RBI|RBM|ELI|ELM|CAO)"
blueItems = "(COL|CRT)"
greenItems = "(AVI|HEG)"
blue2Items = "(\d{1,2}°-\d{1,2}°|\d{1,2}°)"
'-----------------------------------------------------
allItems = redItems & "|" & blueItems & "|" & blue2Items & "|" & greenItems
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = allItems
'-----------------------------------------------------
'On Error Resume Next
If .test(Range(Target.Address).Value) Then
Set RegMC = .Execute(Range(Target.Address).Value)
For Each RegM In RegMC
If InStr(redItems, RegM) Then
Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(255, 0, 0)
ElseIf InStr(blueItems, RegM) Then
Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 59, 255)
ElseIf InStr(blue2Items, RegM) Then
Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 59, 255)
ElseIf InStr(greenItems, RegM) Then
Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 176, 80)
End If
Next
End If
End With
End If
I tried the regex with a simple sub and it worked, but I cant get it to work in the above code
Sub RegExpTemps()
Dim objRegex As Object
Dim RegMC As Object
Dim RegM As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "(\d{1,2}°-\d{1,2}°|\d{1,2}°)"
For row = 10 To 80
If .test(Cells(row, 10).Value) Then
Set RegMC = .Execute(Cells(row, 10).Value)
For Each RegM In RegMC
Cells(row, 10).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 0, 255) 'vbGreen
Next
End If
Next row
End With
End Sub
The expected result is that strings that contain temperatures (have the degree character) are highlighted when the cell content changes
Define the blue2Items
as
blue2Items = "(\d{1,2}°(?:-\d{1,2}°)?)"
It is more concise and means match 1 or 2 digits with °
sign after them and then an optional sequence of -
and again 1 or 2 digits with °
sign .
Then, you need to change the font color based on the capturing group that matched. match.Submatches(x)
lets you access these values and if you check their length, you will know which one matched.
Use
If .test(Range(Target.Address).Value) Then
Set RegMC = .Execute(Range(Target.Address).Value)
For Each RegM In RegMC
If Len(RegM.Submatches(0)) > 0 Then
Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(255, 0, 0)
ElseIf Len(RegM.Submatches(1)) > 0 Then
Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 59, 255)
ElseIf Len(RegM.Submatches(2)) > 0 Then
Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 59, 255)
ElseIf Len(RegM.Submatches(3)) > 0 Then
Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 176, 80)
End If
Next
End If
Test:
I think your expression is fine, maybe we'd add some optional spaces, for just in case, and hopefully it'd work:
(\d{1,2}(?:\s*)°(?:\s*)-(?:\s*)\d{1,2}(?:\s*)°)\s*|(\d{1,2}(?:\s*)°)
The expression is explained on the top right panel of this demo , if you wish to explore/simplify/modify it, and in this link , you can watch how it would match against some sample inputs step by step, if you like.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.