Option Explicit 
Sub Number_Format() 
     ' This code formats all numeric cells on the activesheet to
     ' postive:    Black
     ' negative:    -Red
     ' zero:       " - "
    Dim NumberFormat As String, PosNumberFormat As String 
    Dim Myrange As Range 
    Dim cel As Range 
     
     ' define  unions separately in case either formulas, constants or blank cells do not exists in the Used Range
     ' include blank cells in the Used Range as well so they are pre-formatted in case data is entered
     
    On Error Resume Next 
    Set Myrange = Intersect(ActiveSheet.UsedRange, ActiveSheet.Cells.SpecialCells(xlFormulas)) 
     
    If Myrange Is Nothing Then 
        Set Myrange = Intersect(ActiveSheet.UsedRange, ActiveSheet.Cells.SpecialCells(xlConstants, xlNumbers)) 
    Else 
        Set Myrange = Union(Myrange, Intersect(ActiveSheet.UsedRange, ActiveSheet.Cells.SpecialCells(xlConstants))) 
    End If 
    If Myrange Is Nothing Then 
        MsgBox "There are no constants or formulas on this sheet" & vbNewLine & "The macro will now exit" 
        Exit Sub 
    Else 
        Set Myrange = Union(Myrange, Intersect(ActiveSheet.UsedRange, ActiveSheet.Cells.SpecialCells(xlBlanks))) 
    End If 
    On Error GoTo 0 
    If Myrange Is Nothing Then Exit Sub 
    Application.ScreenUpdating = False 
     'Loop through each cell
    For Each cel In Myrange 
         'Check that cell is a value and not a time or date
        If IsNumeric(cel) And Not IsDate(cel) And InStr(1, cel.Text, ":") = 0 Then 
            NumberFormat = cel.NumberFormat 
            Select Case NumberFormat 
            Case "General" 
                 'do nothing
            Case Else 
                If InStr(NumberFormat, ";") = 0 And InStr(NumberFormat, "]") = 0 Then 
                     ' if negative and zero formatting does not exist then add it to all numeric formats
                    NumberFormat = NumberFormat & ";[Red](-" & NumberFormat & ");""-""??" 
                ElseIf InStr(NumberFormat, "[Red](-") = 0 Or InStr(NumberFormat, " - ") = 0 Then 
                     ' if Red negative numbers formatting or " - " zero number formatting does not exit
                     ' then reformat numeric formattinfg
                    If InStr(NumberFormat, ";") <> 0 Then 
                        PosNumberFormat = Left(NumberFormat, InStr(NumberFormat, ";") - 1) 
                    Else 
                        PosNumberFormat = NumberFormat 
                    End If 
                     ' Remove any colur from the positive portion
                    PosNumberFormat = Right(PosNumberFormat, Len(PosNumberFormat) - InStr(PosNumberFormat, "]")) 
                    NumberFormat = PosNumberFormat & ";[Red](-" & PosNumberFormat & ");""-""??" 
                End If 
                cel.NumberFormat = NumberFormat 
            End Select 
        End If 
    Next 
    Application.ScreenUpdating = True 
End Sub