On Jul 6, 11:41*am, "Rick Rothstein"
wrote:
Give this code a try instead...

Sub FindRedFont()
* Dim UserResponse As Variant
* On Error GoTo NoRedFonts
* Application.FindFormat.Font.ColorIndex = 3
* Range("K12:AI10000").Find("*", After:=Range("AI10000"), _
* * * * SearchFormat:=True, SearchOrder:=xlByColumns).Select
* MsgBox "Please make additional corrections"
* Exit Sub
NoRedFonts:
* UserResponse = MsgBox("Data validated, good job!" _
* * * & vbNewLine & vbNewLine & _
* * * "If the sheet is to be printed, " & _
* * * "clicking on the Print Setup button " & _
* * * "prepares the file for printing.", _
* * * vbExclamation + vbOKCancel, "TEST")
* If UserResponse = vbCancel Then
* * Exit Sub * *'Or other required code
* End If
End Sub

--
Rick (MVP - Excel)

"Ron" wrote in message

...
On Jul 2, 8:32 pm, "Rick Rothstein"



wrote:
Sorry, I forgot to restrict it to your K12:AI10000 range. Here is the
corrected code to do that...

Sub FindRedFont()
Application.FindFormat.Font.ColorIndex = 3
Range("K12:AI10000").Find("*", After:=Range("AI10000"), _
SearchFormat:=True).Select
MsgBox "Please make additional corrections"
End Sub

--
Rick (MVP - Excel)

"Rick Rothstein" wrote in message

. ..

You don't have to loop to do what you want; just run this macro... it
will
select the first cell with an all red font and will then popup the
MessageBox (only one time per running of the macro):

Sub FindRedFont()
Application.FindFormat.Font.ColorIndex = 3
Cells.Find("*", After:=Range("AI10000"), SearchFormat:=True).Select
MsgBox "Please make additional corrections"
End Sub

--
Rick (MVP - Excel)- Hide quoted text -

- Show quoted text -

Hi Fst1. *Love you code however it only picks up a red cell if it's in
the first cell i.e. K12. *Rick I get an error with your code if there
are no red cells. *My scope has changed to include a msgbox should
there be no red cells in my range. *I can't seem to get the first
option of finding a red cell and then a msgbox "Please make additional
corrections" to work. *The code included only produces the second
msgbox. *All assistance greatly appreciated.

Sub testfollowup()
Dim c As Range
Dim userResponse As Variant

For Each c In ActiveSheet.Range("K12:AI10000")
* * If c.Font.ColorIndex = 3 Then
* * * * MsgBox "Please make additional corrections"

* * * * Select Case userResponse
* * * * * * Case vbCancel
* * * * * * * * Exit Sub
* * * * * * Case vbOK
* * * * * * * * Exit Sub
* * * * End Select

* * Else 'if no RED Cells are Found
* * * * userResponse = MsgBox("Data validated, good job!" _
* * * * * * & vbNewLine & _
* * * * * * "If the sheet is to be printed, " & _
* * * * * * "clicking on the Print Setup button " & _
* * * * * * "prepares the file for printing.", _
* * * * * * vbExclamation + vbOKCancel, "TEST")
* * * * Select Case userResponse
* * * * * * Case vbCancel
* * * * * * * * Exit Sub * *'Or other required code
* * * * * * Case vbOK
* * * * * * * * Exit Sub
* * * * End Select
* * End If
Next c

End Sub- Hide quoted text -

- Show quoted text -

Hi Rick, thank you, your solution works perfect. Makes sense, the
ON ERROR GOTO line. Thanks again to all who took a look at or,
contributed to the solution.