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