VBA Express : Excel - Format cells with positive, negative, or zero numerical values in a consistent format.

Excel

Format cells with positive, negative, or zero numerical values in a consistent format.

Ease of Use

Easy

Version tested with

2000, 2003

Submitted by:

brettdj

Description:

This code formats all cells with non-general formats containing numeric values to... positive: Black font negative: Minus sign, Red font, enclosed in brackets zero: as " - " NOTE: General, Date, and Time formats are excluded from any changes

Discussion:

You need to comply to a company standard for producing excel models, or you want to clean up the formatting on a third party model to make it easier to audit.

Code:

instructions for use

			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

How to use:

Copy the code above.
Open your workbook.
Hit Alt+F11 to open the Visual Basic Editor (VBE).
From the menu, choose Insert-Module.
Paste the code into the code window at right.
Close the VBE, and save the file if desired.

Test the code:

Run the macro Number_Format by going to Tools-Macro-Macros and double-click Number_Format.

Sample File:

FormatNumerics(KB20).zip 17.42KB

Approved by mdmackillop

This entry has been viewed 87 times.