Bolding only numbers, % and () in a string, and not texts in between

[seekyourway]

Hi,

I initially got some help with some assistance, but it's not exactly doing intended. I just wanted to bold numbers, % and () in a string, not the texts in between.

sample file:

fjdakgjdkafaj 532253. 50%

dgjdalg 32523432

gdfjadgad (50%) dajgkdalfdksgda. 235234 (53%).adgjdakfdg

adgdfad (50%). Adgjkdfadg 2000(50%).gdafdgd

When i run the code, i got:

fjdakgjdkafaj 532253. 50%

dgjdalg 32523432

gdfjadgad (50%) dajgkdalfdksgda. 235234 (53%).adgjdakfdg

adgdfad (50%). Adgjkdfadg 2000(50%).gdafdgd

But I don't want to bold the texts in between numbers, % and ().

Code I have:

Sub Bolder()
Dim rng As Range, r As Range, strR As String
Dim i As Long, j As Long, k As Long
Set rng = Intersect(Columns(1), ActiveSheet.UsedRange)
For Each r In rng
strR = r.Text
j = 0: k = 0
For i = 1 To Len(strR)
Select Case Asc(Mid(strR, i, 1))
Case Asc(0) To Asc(9), Asc("("), Asc(")"), Asc("%")
If j = 0 Then j = i
k = i
End Select
Next i
r.Characters(j, k - j + 1).Font.Bold = True
Next r
End Sub


Your assistance is greatly appreciated.

 

[Fluff]

How about

Sub seekyourway()
   Dim Cl As Range
   Dim i As Long
   
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      For i = 1 To Len(Cl.Value)
         Select Case Asc(Mid(Cl, i, 1))
            Case 48 To 57, 40, 41, 37
               Cl.Characters(i, 1).Font.Bold = True
         End Select
      Next i
   Next Cl
End Sub

 

[dcardno]

I think you have to explicitly turn off the font attributes after you set them.

Try:

Sub Bolder()
Dim rng As Range
Dim r As Range
Dim strR As String
Dim i As Long
Dim j As Long
Dim k As Long
Set rng = Intersect(Columns(1), ActiveSheet.UsedRange)

For Each r In rng
strR = r.Text
'j = 0: k = 0
For i = 1 To Len(strR)
Select Case Asc(Mid(strR, i, 1))
Case Asc(0) To Asc(9), Asc("("), Asc(")"), Asc("%")
'If j = 0 Then j = i
'k = i
r.Characters(i).Font.Bold = True
Case Else
r.Characters(i).Font.Bold = False
End Select
Next i
'r.Characters(j, k - j + 1).Font.Bold = True
Next r
End Sub

Setting the font character by character will (probably) be a little slower, but whether that matters depends on the size of the file

 

[dcardno]

A little testing indicates that Fluff's solution is significantly faster (~double).

 

[Fluff]

Using

r.Characters(i).Font.Bold = True

will make the font bold from "i" to the end of the string, rather than just that character.

 

[dcardno]

Using

r.Characters(i).Font.Bold = True

will make the font bold from "i" to the end of the string, rather than just that character.

Yes - something I once knew, but had forgotten

 

[seekyourway]

How about

Sub seekyourway()
   Dim Cl As Range
   Dim i As Long
  
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      For i = 1 To Len(Cl.Value)
         Select Case Asc(Mid(Cl, i, 1))
            Case 48 To 57, 40, 41, 37
               Cl.Characters(i, 1).Font.Bold = True
         End Select
      Next i
   Next Cl
End Sub

thank you works perfectly!

 

[Fluff]

Glad we could help & thanks for the feedback

 

[Rick Rothstein]

How about

Sub seekyourway()
   Dim Cl As Range
   Dim i As Long
  
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      For i = 1 To Len(Cl.Value)
         Select Case Asc(Mid(Cl, i, 1))
            Case 48 To 57, 40, 41, 37
               Cl.Characters(i, 1).Font.Bold = True
         End Select
      Next i
   Next Cl
End Sub

This is untested but I am pretty sure you can replace what I highlighted in red above with the following single line of code

Cl.Characters(i, 1).Font.Bold = Mid(Cl, i, 1) Like "[0-9%()]"