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