Change tab color based on cell contents

[worthm]

Hello

I'm using MS Office 2010 and I would like to tie tab color to the value of contents of cell O3 on each of 24 sheets. I've searched the forums here but didn't find the answer. I would prefer to add the code to a module so it affects all 24 sheets in the workbook.

Here is what I want

O3 = 90% and up = Green tab
O3= 80% to < 90% = Yellow tab
O3 = Less than 80% = Red tab
O3 = div/0 = white or plain tab

This is very similar to using conditional formatting with icon sets but I don't know how to apply this to a tab color and I am not a programmer. Thanks in advance for any help!

[Paul_Hossler]

I put this into the ThisWorkbook module (different from a Standard Module) so that they'd apply to ALL worksheets. If there are there are any that should NOT be processed, that logic can be added easily

Since it's possible that O3 on one sheet might be changed as a result of a change to another worksheet, I used the Workbook_SheetCalculate event so this assumes that the WB will be recalculated



Option Explicit

'O3 = 90% and up = Green tab
'O3= 80% to < 90% = Yellow tab
'O3 = Less than 80% = Red tab
'O3 = div/0 = white or plain tab

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Application.StatusBar = "WS_Calculatee = " & Sh.Name & " -- O3 = " & Sh.Range("O3").Text
Call pvtChangeTagColor(Sh)
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Sh.Range("O3"), Target) Is Nothing Then Exit Sub
Application.StatusBar = "WS_Change = " & Sh.Name & " -- O3 = " & Sh.Range("O3").Text
Call pvtChangeTagColor(Sh)
End Sub

Private Sub pvtChangeTagColor(Sh As Object)
With Sh
If IsError(.Range("O3").Value) Then
.Tab.Color = xlAutomatic
ElseIf .Range("O3").Value >= 0.9 Then
.Tab.Color = vbGreen
ElseIf .Range("O3").Value >= 0.8 Then
.Tab.Color = vbYellow
Else
.Tab.Color = vbRed
End If
End With
End Sub



Here's a small sample, but ask if you have any questions

Oh, and welcome to the forum :yes

[worthm]

Paul,
Thank you so much! That works perfectly. I had asked the same question on another site and someone gave me a piece of code which was tied to a macro. You had to click the macro to get the tabs to show color but this is so much better. Thanks again!

[dratkison]

Worked great! Thanks for the post!


I put this into the ThisWorkbook module (different from a Standard Module) so that they'd apply to ALL worksheets. If there are there are any that should NOT be processed, that logic can be added easily

Since it's possible that O3 on one sheet might be changed as a result of a change to another worksheet, I used the Workbook_SheetCalculate event so this assumes that the WB will be recalculated



Option Explicit

'O3 = 90% and up = Green tab
'O3= 80% to < 90% = Yellow tab
'O3 = Less than 80% = Red tab
'O3 = div/0 = white or plain tab

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Application.StatusBar = "WS_Calculatee = " & Sh.Name & " -- O3 = " & Sh.Range("O3").Text
Call pvtChangeTagColor(Sh)
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Sh.Range("O3"), Target) Is Nothing Then Exit Sub
Application.StatusBar = "WS_Change = " & Sh.Name & " -- O3 = " & Sh.Range("O3").Text
Call pvtChangeTagColor(Sh)
End Sub

Private Sub pvtChangeTagColor(Sh As Object)
With Sh
If IsError(.Range("O3").Value) Then
.Tab.Color = xlAutomatic
ElseIf .Range("O3").Value >= 0.9 Then
.Tab.Color = vbGreen
ElseIf .Range("O3").Value >= 0.8 Then
.Tab.Color = vbYellow
Else
.Tab.Color = vbRed
End If
End With
End Sub



Here's a small sample, but ask if you have any questions

Oh, and welcome to the forum :yes