Change Tab Color base on value of cell % Change

[mrprofit]

I have code like this, but it does not change to the right color,



If Sheets("Sheet3").Range("S45").Value > "0.00" Then
Sheets("Sheet3").Tab.ColorIndex = 5 '-----Change Tab Color (Blue)
Sheets("Sheet1").Tab.ColorIndex = 5 '-----Change Tab Color (Blue) > 0.00%
Sheets("Sheet2").Tab.ColorIndex = 5 '-----Change Tab Color (Blue)
End If
If Sheets("Sheet3").Range("S45").Value > "3.00%" Then
Sheets("Sheet3").Tab.ColorIndex = 4 '-----Change Tab Color (Green)
Sheets("Sheet1").Tab.ColorIndex = 4 '-----Change Tab Color (Green) > 3.00%
Sheets("Sheet2").Tab.ColorIndex = 4 '-----Change Tab Color (Green)
End If
If Sheets("Sheet3").Range("S45").Value < "0.00" Then
Sheets("Sheet3").Tab.ColorIndex = 46 '-----Change Tab Color (Orange)
Sheets("Sheet1").Tab.ColorIndex = 46 '-----Change Tab Color (Orange) < 0.00%
Sheets("Sheet2").Tab.ColorIndex = 46 '-----Change Tab Color (Orange)
End If
If Sheets("Sheet3").Range("S45").Value < "-3.00%" Then
Sheets("Sheet3").Tab.ColorIndex = 3 '-----Change Tab Color (Red)
Sheets("Sheet1").Tab.ColorIndex = 3 '-----Change Tab Color (Red) < -3.00%
Sheets("Sheet2").Tab.ColorIndex = 3 '-----Change Tab Color (Red)
End If

End Sub

[Admin]

Hi

try


Option Explicit

Sub kTest()

Dim tColor As Long

tColor = Evaluate("=LOOKUP('Sheet3'!S45,{-9.99,3;-0.03,46;0,5;0.03,4})")

Sheets("Sheet3").Tab.ColorIndex = tColor
Sheets("Sheet1").Tab.ColorIndex = tColor
Sheets("Sheet2").Tab.ColorIndex = tColor

End Sub

[mrprofit]

Works, Thank you

now i have another question, possible to use a cell R1 to replace the 0.03 in the code? R1 = 3%, so S45 < R1 then change Tabcolor to Red etc,

[Admin]

Are you always compare S45 to R1 or different cells for different values ?

[mrprofit]

I will compare it to R1 always, and possible to add another R2 =10%, then Change to Tabcolor to another color

Thank you for your help

[Admin]

Hi

You mean like this ?


Option Explicit

Sub kTest()

Dim S45_Value As Double
Dim R1_Value As Double

S45_Value = Sheets("Sheet3").Range("S45").Value
R1_Value = Sheets("Sheet3").Range("R1").Value

Select Case True
Case S45_Value > R1_Value
If S45_Value > 0.03 Then
Sheets("Sheet3").Tab.ColorIndex = 4
Sheets("Sheet2").Tab.ColorIndex = 4
Sheets("Sheet1").Tab.ColorIndex = 4
ElseIf S45_Value > 0 Then
Sheets("Sheet3").Tab.ColorIndex = 5
Sheets("Sheet2").Tab.ColorIndex = 5
Sheets("Sheet1").Tab.ColorIndex = 5
End If
Case S45_Value < R1_Value
If S45_Value < 0 Then
Sheets("Sheet3").Tab.ColorIndex = 46
Sheets("Sheet2").Tab.ColorIndex = 46
Sheets("Sheet1").Tab.ColorIndex = 46
ElseIf S45_Value < -0.03 Then
Sheets("Sheet3").Tab.ColorIndex = 3
Sheets("Sheet2").Tab.ColorIndex = 3
Sheets("Sheet1").Tab.ColorIndex = 3
End If
End Select

End Sub

[mrprofit]

instead of using all the sheets name, what code to just choose all sheets



Sheets("Sheet3").Tab.ColorIndex = 46
Sheets("Sheet2").Tab.ColorIndex = 46
Sheets("Sheet1").Tab.ColorIndex = 46

it this the code ?

worksheets.Tab.ColorIndex = 46

[Rick Rothstein]

instead of using all the sheets name, what code to just choose all sheets



Sheets("Sheet3").Tab.ColorIndex = 46
Sheets("Sheet2").Tab.ColorIndex = 46
Sheets("Sheet1").Tab.ColorIndex = 46

it this the code ?

worksheets.Tab.ColorIndex = 46

Try it this way...

Dim WS As WorkSheet
....
....
For Each WS in Worksheets
WS.Tab.ColorIndex = 46
Next

[mrprofit]

Thank you Rick