Sub SelectiveColor1()
If TypeName(Selection) <> "Range" Then Exit Sub
Const REDINDEX = 3
Application.ScreenUpdating = False
For Each Cell In Selection
If Cell.value < 0 Then
Cell.Interior.ColorIndex = REDINDEX
Else
Cell.Interior.ColorIndex = xlNone
End If
Next Cell
End Sub