Find all cells with font color in whole workbook...

[spacely]

Hello,

This code is not returning more than the number of sheets in a book. Each sheet has plenty of Red font cells. Not conditional format.

Dim Sh As Worksheet
i = 0
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
With Application.FindFormat.Font
.Subscript = False
.Color = 255
.TintAndShade = 0
End With
Set c = Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
If Not c Is Nothing Then
i = i + 1
End If
End With
Next
MsgBox i

Any ideas?

Dave

 

[Rick Rothstein]

Hello,

This code is not returning more than the number of sheets in a book. Each sheet has plenty of Red font cells. Not conditional format.

Dim Sh As Worksheet
i = 0
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
With Application.FindFormat.Font
.Subscript = False
.Color = 255
.TintAndShade = 0
End With
Set c = sh.Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
If Not c Is Nothing Then
i = i + 1
End If
End With
Next
MsgBox i

Any ideas?

Untested, but I think you need to add what I show in red above and remove what I show in blue (make sure to leave the commas though).

Edit Note: Actually, I don't think your code will work even with the above changes because you do not seem to be counting the red cells (you do not have a loop iterating them).

 

[Rick Rothstein]

Edit Note: Actually, I don't think your code will work even with the above changes because you do not seem to be counting the red cells (you do not have a loop iterating them).

I think this macro will do what you appear to be asking for...

Sub CountRedFontCells()
  Dim Cnt As Long, FirstAddr As String, WS As Worksheet, C As Range
  Application.FindFormat.Clear
  Application.FindFormat.Font.Color = vbRed
  For Each WS In Worksheets
    With WS.UsedRange
      Set C = .Find("*", , , , , , , , True)
      If Not C Is Nothing Then
        FirstAddr = C.Address
        Do
          Cnt = Cnt + 1
          Set C = .Find("*", C, , , , , , , True)
        Loop While Not C Is Nothing And C.Address <> FirstAddr
      End If
    End With
  Next
  Application.FindFormat.Clear
  MsgBox Cnt
End Sub

 

[Rick Rothstein]

Untested, but I think you need to add what I show in red above and remove what I show in blue (make sure to leave the commas though).

Edit Note: Actually, I don't think your code will work even with the above changes because you do not seem to be counting the red cells (you do not have a loop iterating them).

After you reply to a message and post your text and code (important... with code tags surrounding it), click the "Go Advanced" button, select your code but not the code tags and click the table icon (bottom left icon in ribbon) and change the first two fields to 1 (one) and then OK it.

 

[spacely]

Hmm, I may have been to aggressive. How can I just search the Active or "This" sheet?

Thanks Rick

 

[Rick Rothstein]

Hmm, I may have been to aggressive. How can I just search the Active or "This" sheet?

Just remove the For..Next loop and change the sheet reference to ActiveSheet...

Sub CountRedFontCells()
  Dim Cnt As Long, FirstAddr As String, WS As Worksheet, C As Range
  Application.FindFormat.Clear
  Application.FindFormat.Font.Color = vbRed
  With ActiveSheet.UsedRange
    Set C = .Find("*", , , , , , , , True)
    If Not C Is Nothing Then
      FirstAddr = C.Address
      Do
        Cnt = Cnt + 1
        Set C = .Find("*", C, , , , , , , True)
      Loop While Not C Is Nothing And C.Address <> FirstAddr
    End If
  End With
  Application.FindFormat.Clear
  MsgBox Cnt
End Sub

 

[spacely]

Rick, I added a line, now it crashes with "Object Variable or With Block variable not set"... it points to the Loop While Not line:

Sub CountRedFontCells()
Dim Cnt As Long, FirstAddr As String, WS As Worksheet, C As Range
Application.FindFormat.Clear
Application.FindFormat.Font.Color = vbRed
With ActiveSheet.UsedRange
Set C = .Find("*", , , , , , , , True)
If Not C Is Nothing Then
FirstAddr = C.Address
Do
' Cnt = Cnt + 1
C.Font.ColorIndex = 0
Set C = .Find("*", C, , , , , , , True)
Loop While Not C Is Nothing And C.Address <> FirstAddr
End If
End With
Application.FindFormat.Clear
' MsgBox Cnt
End Sub

 

[Rick Rothstein]

Rick, I added a line, now it crashes with "Object Variable or With Block variable not set"... it points to the Loop While Not line:

Sub CountRedFontCells()
Dim Cnt As Long, FirstAddr As String, WS As Worksheet, C As Range
Application.FindFormat.Clear
Application.FindFormat.Font.Color = vbRed
With ActiveSheet.UsedRange
Set C = .Find("*", , , , , , , , True)
If Not C Is Nothing Then
FirstAddr = C.Address
Do
' Cnt = Cnt + 1
C.Font.ColorIndex = 0
Set C = .Find("*", C, , , , , , , True)
Loop While Not C Is Nothing And C.Address <> FirstAddr
End If
End With
Application.FindFormat.Clear
' MsgBox Cnt
End Sub

You should really not try to simply your questions for us... just ask for what you need. If I understand what your modification is doing, you are simply changing all red fonts to black fonts, correct? If so...

Sub MakeAllFontsBlack()
  Cells.Font.ColorIndex = 0
End Sub

or, if you have other colored fonts beside red and only want to change the red font but leave any other colored fonts alone...

Sub MakeOnlyRedFontsBlack()
  With Application
    .FindFormat.Clear
    .ReplaceFormat.Clear
    .FindFormat.Font.Color = vbRed
    .ReplaceFormat.Font.Color = vbBlack
    Cells.Replace "", "", , , , , True, True
    .FindFormat.Clear
    .ReplaceFormat.Clear
  End With
End Sub

 

[spacely]

Sorry, yes, just Red to Black.

In your other solution, i just put my added line after the Set C line, then it worked.

Thanks.

 

[Rick Rothstein]

Sorry, yes, just Red to Black.

Meaning you have other font colors you do not want to change, correct? If so, then use the second macro I posted in Message #8 , otherwise use the first one.

In your other solution, i just put my added line after the Set C line, then it worked.

The code I posted in Message #8 should be more efficient (probably not visibly so, though) as it makes the changes all at once rather than cell by cell.