Find First Cell With a Font ColorIndex =3

  • Thread starter Thread starter Ron
  • Start date Start date
R

Ron

Hi all,

I'm trying to find the first cell with a font ColorIndex that equals 3
(Red). Then a MsgBox with a comment. This is where I'm at and I
don't think my code is finding the cell with red fonts.

Sub testfollowup()

Dim c As Range

For Each c In ActiveSheet.Range("K12:AI10000")
If ColorIndex = 3 Then

MsgBox "Please make additional corrections"

End If

Next c

End Sub

Thank you all for any assistance,
 
hi
try this......
Sub testfollowup()
Dim c As Range
For Each c In ActiveSheet.Range("K12:AI10000")
If c.Font.ColorIndex = 3 Then
MsgBox "Please make additional corrections"
End If
Next c
End Sub

regards
FSt1
 
How did the font become red... by using conditional formatting or by
directly setting it?
 
How did the font become red... by using conditional formatting or by
directly setting it?

--
Rick (MVP - Excel)















- Show quoted text -
Click to expand...

Hello, font was set to red to flag an error. The code provided by
Fst1 works however, if I have more than one occurance of the red font
clicking OK or Cancel does not dismiss the msgbox and I have to kill
Excel to get out of the message box. Any suggestions? Greatly
appreciated. Thanks, Ron
 
hi
add this if you don't want the second occurance.
Sub testfollowup()
Dim c As Range
For Each c In ActiveSheet.Range("K12:AI10000")
If c.Font.ColorIndex = 3 Then
MsgBox "Please make additional corrections"
exit sub'*******************
End If
Next c
End Sub

regards
FSt1
 
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
 
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
 
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)







- Show quoted text -
Click to expand...
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
 
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)


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)







- Show quoted text -
Click to expand...
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
 
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)






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 -
Click to expand...

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.
 
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.- Hide quoted text -

- Show quoted text -
Click to expand...

Hi Rick, I have ran into a few problems with this code. I changed
the find a font.colorIndex=3 cell to find a cell with
Interior.ColorIndex = 3 but my code is not finding anything. I think
there is something with the wildcard part of the search. The reason
for the change is I needed to flag a blank cell (if there is one) in
one of the columns so, the red font did not work in the case of a
blank cell. The final search would not find any cells with
Interior.ColorIndex = 3. I altered you solution to the red font to
red interior. Any assistance greatly appreciated.

Sub FindRedFont()
Dim UserResponse As Variant
On Error GoTo NoRedFonts
Application.FindFormat.Interior.ColorIndex = 3
Range("I12:AI10000").Find("*", After:=Range("AI10000"), _
SearchFormat:=True, SearchOrder:=xlByColumns).Select

MsgBox "Please correct any cells highlighted RED and click on the
Validate Button" & vbNewLine & "" & vbNewLine & _
"", , "Jrnl 1 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
 
Back
Top