Bold and color numbers in specific format with special character

[Webbers]

Hi all!

I found a great and functional code here, which was written by Yongle. I modified the code, however I don't want to be forced to manually hardcode all the variables that could appear. There are numbers, rather than specific text, and they are all in the same format with a parenthesis before and after the number, such as (1), (2), (3), and so forth. I would like all numbers (and the parenthesizes) to be bold and green (color index 10).



Sub Find_and_Bold()


Dim rCell As Range, sToFind As String, iSeek As Long
Dim Text(1 To 5) As String
Dim i As Integer

Text(1) = "(1)"
Text(2) = "(2)"
Text(3) = "(3)"
Text(4) = "(4)"
Text(5) = "(5)"


For i = LBound(Text) To UBound(Text)
For Each rCell In Range("G1:G50")
sToFind = Text(i)
iSeek = InStr(1, rCell.Value, sToFind)
Do While iSeek > 0
rCell.Characters(iSeek, Len(sToFind)).Font.Bold = True
iSeek = InStr(iSeek + 1, rCell.Value, sToFind)
Loop
Next rCell
Next i


End Sub

[Leith Ross]

Hello Webbers,

Welcome!

This amended version worked in my tests.



b Find_and_Bold()


Dim rCell As Range, sToFind As String, iSeek As Long
Dim Text(1 To 5) As String
Dim i As Integer


Text(1) = "(1)"
Text(2) = "(2)"
Text(3) = "(3)"
Text(4) = "(4)"
Text(5) = "(5)"




For i = LBound(Text) To UBound(Text)
For Each rCell In Range("G1:G50")
sToFind = Text(i)
iSeek = InStr(1, rCell.Value, sToFind)
If iSeek > 0 Then
Do
With rCell.Characters(iSeek, Len(sToFind)).Font
.Bold = True
.ColorIndex = 10
End With
iSeek = InStr(iSeek + Len(sToFind), rCell.Value, sToFind)
If iSeek = 0 Then Exit Do
Loop
End If
Next rCell
Next i


End Sub

[mana]

Sub test()
Dim reg As Object, s As String, m As Object
Dim r As Range, c As Range
Const myColor = 10

Set reg = CreateObject("vbscript.regexp")
s = "\(\d+\)"
Set r = Columns("g").SpecialCells(xlCellTypeConstants)

r.Font.Bold = False
r.Font.ColorIndex = xlAutomatic

With reg
.Global = True
.Pattern = s
For Each c In r
For Each m In .Execute(c.Value)
With c.Characters(m.firstindex + 1, m.Length).Font
.Bold = True
.ColorIndex = myColor
End With
Next
Next
End With

End Sub