|
Sub SelectiveColor2()
Dim FormulaCells As range
Dim ConstantCells As range
Const REDINDEX = 3
On Error Resume Next
Application.ScreenUpdating = False
Set FormulaCells = Selection.SpecialCells(xlFormulas, xlNumbers)
Set ConstantCells = Selection.SpecialCells(xlConstants, xlNumbers)
For Each Cell In FormulaCells
If Cell.value < 0 Then _
Cell.Font.ColorIndex = REDINDEX
Next Cell
For Each Cell In ConstantCells
If Cell.value < 0 Then
Cell.Interior.ColorIndex = REDINDEX
Else
Cell.Interior.ColorIndex = xlNone
End If
Next Cell
End Sub
|