VBA Find red text within cell and make bold

qapla47

New Member
Joined
Jun 23, 2016
Messages
24
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?
Code:
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):
[TABLE="width: 1812"]
<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col span="2"></colgroup><tbody>[TR]
[TD]Job #[/TD]
[TD]Client[/TD]
[TD]Description[/TD]
[TD]Qty[/TD]
[TD]Due Date[/TD]
[TD]Stock Ord[/TD]
[TD]Stock in[/TD]
[TD]Co.[/TD]
[TD]Press/Impo[/TD]
[TD]Ink Plated[/TD]
[TD]Status[/TD]
[TD]Changes[/TD]
[TD]Bindery / Outside Services / Notes[/TD]
[TD]Last Contact[/TD]
[TD]Priority[/TD]
[TD]Current[/TD]
[TD]Next[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]HOLD[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD="align: right"]0[/TD]
[TD]Hold[/TD]
[TD]Hold[/TD]
[/TR]
[TR]
[TD]20101[/TD]
[TD]Martin Group Mock Up Out[/TD]
[TD]Cancer Ctr Statement Brochure[/TD]
[TD]510[/TD]
[TD]18-Jan[/TD]
[TD]order[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Digital / Kluge[/TD]
[TD]4/4[/TD]
[TD]Wait for Files[/TD]
[TD] [/TD]
[TD]12pg + cover - cvt has a pocket, D/C hand stitch[/TD]
[TD="align: right"]03 Jan[/TD]
[TD="align: right"]4[/TD]
[TD]Hold[/TD]
[TD]D. Pre-Press[/TD]
[/TR]
[TR]
[TD]20036[/TD]
[TD]Klein Steel[/TD]
[TD]2017 Product Catalog[/TD]
[TD]250/500[/TD]
[TD]tbd[/TD]
[TD]order[/TD]
[TD] [/TD]
[TD] [/TD]
[TD]R5[/TD]
[TD]4/4[/TD]
[TD]wait for files[/TD]
[TD] [/TD]
[TD]wire bound book 100 pgs SAMPLES OUT[/TD]
[TD="align: right"]03 Jan[/TD]
[TD="align: right"]7[/TD]
[TD]Hold[/TD]
[TD]Pre-Press[/TD]
[/TR]
</tbody>[/TABLE]

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

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top