VBA Find red text within cell and make bold

[qapla47]

Hi All,
I've been playing with this for a while, and can't quite seem to get it to work...
I'm trying to search within a range of cells, for cells that contain red text, and then make only that text bold.
Cells could contain both black and red text, but only the red should be bolded.

This is the macro I have it in, which does many other things besides, perhaps I'm just locating it in the wrong place? On it's own, it seemed to work, but once inside the larger macro, it crashes excel. I've highlighted the segment that isn't working

Any ideas?

Sub BoxBorders()


'Defined for later
    Dim rfound As Range
    Dim FirstAdr As String
    
    
'erases all cell borders currently in effect throughout the entire sheet
  With Cells.Select
    Selection.Borders.LineStyle = xlNone
    Selection.Interior.ColorIndex = 0
  End With


    
'applies all borders to the active segment of the sheet
  With Range("A1:Q" & Cells(Rows.Count, "A").End(xlUp).Row)
    For i = 7 To 12
      .Borders.Item(i).LineStyle = xlContinuous
      .Borders.Item(i).Weight = xlThin
    Next i
  End With
  
'This segment changes row 1 to Arial Narrow Bold
  With Range("A1:M1").Font
   .Name = "Arial Narrow"
   .FontStyle = "Bold"
   .Size = 12
  End With
  
  'This segment changes the header bar to orange
  With Range("A1:Q1").Select
  Selection.Interior.ColorIndex = 40
  End With
 
 'This segment applies a box border to the printable area and changes the fonts as listed
  With Range("A3:M" & Cells(Rows.Count, "A").End(xlUp).Row)
    .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
  End With


'sets printable area to Arial Regular
  With Range("A3:M" & Cells(Rows.Count, "A").End(xlUp).Row).Font
    .Name = "Arial"
    .FontStyle = "Regular"
    .Size = 12
  End With
    
  'bolds column E
  With Range("E:E").Font
    .FontStyle = "Bold"
  End With
   
  'sets non-printable area to calibri
  With Range("N1:Q" & Cells(Rows.Count, "A").End(xlUp).Row).Font
    .Name = "Calibri"
    .Size = 10.5
  End With
  
[COLOR=#008000]'this section is broken, should find RED characters and bold them - crashes[/COLOR]
[COLOR=#008000]'sometimes works, but causes error in line 53 - makes all text red then crashes when you try to fix manually[/COLOR]
[COLOR=#008000]  'With Range("M3:M" & Cells(Rows.Count, "A").End(xlUp).Row).Select[/COLOR]
[COLOR=#008000]    'For Each cell In Selection[/COLOR]
[COLOR=#008000]        'For i = 1 To Len(cell)[/COLOR]
[COLOR=#008000]            'If cell.Characters(i, 1).Font.ColorIndex = 3 Then[/COLOR]
[COLOR=#008000]                'cell.Characters(i, 1).Font.FontStyle = "Bold"[/COLOR]
[COLOR=#008000]            'End If[/COLOR]
[COLOR=#008000]        'Next i[/COLOR]
[COLOR=#008000]    'Next cell[/COLOR]
[COLOR=#008000]  'End With[/COLOR]
  
'This is the segment searches for the number 0, in column O, then applies a defined border style to all rows that match
'the find in a range of A:Q. It also loops to find the remaining instances.
   
   With Columns("O:O")
        Set rfound = .Find(What:="0", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
               If Not rfound Is Nothing Then
                   FirstAdr = rfound.Address
               Else
                   MsgBox "No 0's found in Column O. Please unhide Column O"
                   Exit Sub
               End If
               
               Do
        Set rfound = .FindNext(rfound)
                   With rfound.Offset(, -14).Resize(, 17).Borders(xlInsideVertical)
                        .LineStyle = xlNone
                   End With
                   With rfound.Offset(, -14).Resize(, 17).Borders(xlEdgeRight)
                        .LineStyle = xlNone
                   End With
                   With rfound.Offset(, -14).Resize(, 17).Borders(xlEdgeBottom) 'The offset takes us back to the cell in column A, the resize takes us from A to Q....
                       .ColorIndex = 0
                       .Weight = xlMedium
                   End With
                   With rfound.Offset(, -14).Resize(, 17).Borders(xlEdgeTop)
                       .ColorIndex = 0
                   End With
                   With rfound.Offset(, -14).Resize(, 17)
                   .Interior.ColorIndex = 15
                   End With
                   With rfound.Offset(, -14).Resize(, 3).Font
                   .Name = "Arial Black"
                   .Size = 12
                   End With
               Loop Until rfound.Address = FirstAdr
    End With


  End Sub

Here's a small segment of what my spreadsheet basically looks like (but without all of the various macros and conditional formatting):

Job #

Client

Description

Qty

Due Date

Stock Ord

Stock in

Co.

Press/Impo

Ink Plated

Status

Changes

Bindery / Outside Services / Notes

Last Contact

Priority

Current

Next

HOLD

0

Hold

Hold

20101

Martin Group Mock Up Out

Cancer Ctr Statement Brochure

510

18-Jan

order

Digital / Kluge

4/4

Wait for Files

12pg + cover - cvt has a pocket, D/C hand stitch

03 Jan

4

Hold

D. Pre-Press

20036

Klein Steel

2017 Product Catalog

250/500

tbd

order

R5

4/4

wait for files

wire bound book 100 pgs SAMPLES OUT

03 Jan

7

Hold

Pre-Press

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col span="2"></colgroup><tbody>
</tbody>

At the moment I've restricted the macro to just column M (Bindery/Outside Services/Notes), regardless, it isn't working...