Find First Cell With a Font ColorIndex =3

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,
 
F

FSt1

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
 
R

Rick Rothstein

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

Ron

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
 
F

FSt1

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
 
R

Rick Rothstein

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
 
R

Rick Rothstein

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
 
R

Ron

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
 
R

Rick Rothstein

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
 
R

Ron

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.
 
R

Ron

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Find Cell When Interior.ColorIndex =3 1
VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key 0
Cannot Dismiss the MsgBox 4
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
Run - time error '1004' 1
Run Error while protected 1
Need help modifying code 0
Protection in VBA. 2

Top