VBA Code for numbers colors-for different format cell criteria

[amartakale]

Dear Sir

I handle large database excel.

So I want VBA Code for numbers colors-for different format cell criteria
1) Calcualtion-Brown
2) Hard code numbers-Black
3) Italic % numbers-blue
4) external link numbers-Green
5) Negative Numbers-Red in double bracket

if code input in database excel then numbers automatically reflect as per above criteria also change color when i manually input numbers or calcualtion or link cell from external file in database excel.

Regards
Amar

[amartakale]

hi Pual sir,can you help me?

[Paul_Hossler]

It's do-able, but your requirements are very much ambigious

Do you only want to change the font color or the cell fill color or both?

What is a formula results in 25.20%? Do you want the in Brown or in Blue?

What is a hard coded number is negative? do you want that in Black or [Red]?

You will need to be LOT more specific

[amartakale]

Dear Pual Sir

Sorry for late reply



Cell Number formatting (font color) Required






1) % Calculation Numbers in Blue and other % hardcode Numbers remain black



2) Only Calcualtion Numbers in Brown & other hardcode Numbers remain black



3) external link numbers in Green



4) All Negative numbers (formula+absolute) with barcket in red color




Regards
Amar23245

[Paul_Hossler]

Try this as first attempt




Option Explicit
'% Calculation Numbers in Blue and other % hardcode Numbers remain black
'Only Calcualtion Numbers in Brown & other hardcode Numbers remain black
'external link numbers in Green
'All Negative numbers (formula+absolute) with barcket in red color


Sub ColorCode()

Dim r As Range, r1 As Range, c As Range

Set r = ActiveSheet.Range("C3").CurrentRegion
r.Font.ColorIndex = 1 ' black

Set r1 = Nothing
On Error Resume Next
Set r1 = r.SpecialCells(xlCellTypeFormulas, xlNumbers)
On Error GoTo 0

If Not r1 Is Nothing Then
For Each c In r1.Cells
If Right(c.Text, 1) = "%" Then
c.Font.ColorIndex = 5 ' blue
Else
c.Font.Color = RGB(165, 42, 42) ' brown
End If

If c.Value < 0# Then
c.Value = "[" & c.Value & "]"
c.Font.ColorIndex = 3 ' red (formulas)
End If
Next
End If

Set r1 = Nothing
On Error Resume Next
Set r1 = r.SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0

If Not r1 Is Nothing Then
For Each c In r1.Cells
If c.Value < 0# Then
c.Value = "[" & c.Value & "]"
c.Font.ColorIndex = 3 ' red (constants)
End If
Next
End If

For Each c In r.Cells
If c.Hyperlinks.Count > 0 Then
c.Font.ColorIndex = 50 ' green
End If
Next
End Sub

[amartakale]

Dear Pual Sir

Thanks for your effort.
I want VBA for whole sheet not for range. And current code for external link cell is not work it show brown color.
I required negative numbers in Bracket like this (3.8) not like this [3.8].

I required for external link in cell then font cell will show in Green.

Thanks
Amar

[amartakale]

Currently I have below custom formatting

1) [Blue]_(* #,##0.0_);[Red]_(* (#,##0.0);[Blue]_(* -_);_(@_)

for calculate absolute numbers ,cell font show black & for Hardcode absolute numbers ,cell font show blue

2) [Black]_(* #,##0.0_);[Red]_(* (#,##0.0);[Black]_(* -_);_(@_)

If calculate absolute numbers result in Negative then cell font show Red Otherwise remain Black

3) [Black]0.0%;[Red](0.0%)

If calculate % numbers result in Negative then cell font show Red Otherwise remain Black

Above custom formatting is also OK for me only will be add External cell link then cell font show in Green

[Paul_Hossler]

Try this then




Option Explicit


Sub ColorCode()
Dim r As Range, r1 As Range, c As Range
Dim rF As Range, rC As Range
Set r = ActiveSheet.UsedRange
'all black to start
r.Font.ColorIndex = 1 ' black

On Error Resume Next
Set rF = r.SpecialCells(xlCellTypeFormulas, xlNumbers)
Set rC = r.SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0

If rC Is Nothing And Not rF Is Nothing Then
Set r1 = rF
ElseIf Not rC Is Nothing And rF Is Nothing Then
Set r1 = rC
ElseIf Not rC Is Nothing And Not rF Is Nothing Then
Set r1 = Union(rF, rC)
ElseIf rC Is Nothing And Not rF Is Nothing Then
Exit Sub
End If

For Each c In r1.Cells
If c.HasFormula Then
'calculated % in blue
If Right(c.Text, 1) = "%" Then
c.NumberFormat = "[Blue]0.0%;[Red](0.0%)"

ElseIf InStr(c.Formula, "[") > 0 Then
c.Font.ColorIndex = 4 ' green

'other calculations in brown
Else
c.Font.ColorIndex = 53
End If

'constants positive and zero in black, negative in red
Else
c.NumberFormat = " [Black]_(* #,##0.0_);[Red]_(* (#,##0.0);[Black]_(* -_);_(@_)"
End If
Next
End Sub

[amartakale]

Dear Pual Sir

Perfect,You are done it………
I am really thankful for its wonderful VBA.

Can we create brown numbers in Bold format?

Regards
Amar

[Paul_Hossler]

Add one more line





'other calculations in brown
Else

c.Font.ColorIndex = 53
c.Font.Bold = True
End If

[amartakale]

:clap:Thanks Sir