Change color of tabs in Excel on specific cell value?

[JanHereOpera]

Hi,
I have a workbook with multiple sheets, each sheet is formatted identically - in each B column (from cell B4-B100) I can choose 4 different values (empty - no formating, "OK" - green, "Risk" - yellow and "Skada" Red) the cell changes color depending on these values. I would like to achieve that also each tab - changes color automatically to green, yellow or red depending on these 3 values in any cell (B4-B100) .
Is it possible to achieve this? If so could you walk me through it step by step?
Thanks in advance for any help.

 

[saboh12617]

Hello,
You can do it via VBA. To do so, here is the process
1. Detect that a cell indicating a worksheet color has changed. It can be done with Worksheet.Change event (Excel)
2. Read the worksheet name, and ensure it exists in the workbook. We loop on the worksheets names to check them, and assign a variable to the matching sheet name.
3. Change the worksheet color according to the value in the cell. Again we will check if the value is in the list, and otherwise do nothing.
Please find below and code example. You did not mention 1 crucial thing which is where are the sheets names located. I will assume they are on column A, aligned with their corresponding state in column B:

' step 1
Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("B2:B100")) Is Nothing Then Exit Sub
  ' we assume only one cell can be changed at a time
  If Target.Count > 1 Then Exit Sub
 
  ' step 2
  Dim sht As Worksheet, mySht As Worksheet
  For Each sht In ThisWorkbook.Worksheets
    If sht.Name = Target.Offset(0, -1).Value2 Then
      Set mySht = sht
      Exit For
    End If
  Next sht
  ' sheet does not exist/incorrect spelling
  If mySht Is Nothing Then Exit Sub
 
  ' step 3
  Select Case VBA.LCase$(Target.Value2)
  Case vbNullString
    mySht.Tab.Color = xlNone
  Case "ok"
    mySht.Tab.Color = vbGreen
  Case "risk"
    mySht.Tab.Color = vbYellow
  Case "skada"
    mySht.Tab.Color = vbRed
  End Select
End Sub

 

[JanHereOpera]

Hi, thanks so much for your swift reply. The Sheet's name is always indicated in cell "C1" on each sheet.

 

[saboh12617]

Sorry i can not figure out the structure of your workbook. Seems very strange to me.

My proposition applies to a presentation like this one

 

[JanHereOpera]

Sorry for the confusion, my spreadsheet looks following: each sheet has one column (B) where on each cell of the column (B4:B100) I can select out of 3 different options (Ok, Risk, Skada). According to this value the cell changes a color, what I am after is to connect this action to automatically changing the color of the sheet tab according to the B column cells (always according to the newest one).
Does it make a better sence?

 

[saboh12617]

Ah okay thanks for the clarification, i understand better now. Then i would do the following:

Instead of implementing the worksheet change event in all sheets, we will use the workbook sheetchange event instead. And we basically copy/paste the code with a little adaptation since we do not need to search the sheet name (step 2 essentially).

Please find below the new code. Be sure to put it in the "ThisWorkbook" module.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' step 1
  If Intersect(Target, Sh.Range("B4:B100")) Is Nothing Then Exit Sub
  ' we assume only one cell can be changed at a time
  If Target.Count > 1 Then Exit Sub
 
  ' step 3
  Select Case VBA.LCase$(Target.Value2)
  Case vbNullString
    Sh.Tab.Color = xlNone
  Case "ok"
    Sh.Tab.Color = vbGreen
  Case "risk"
    Sh.Tab.Color = vbYellow
  Case "skada"
    Sh.Tab.Color = vbRed
  End Select
End Sub

 

[Fluff]

Another option is

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   
   If Not Intersect(Target, Sh.Range("B4:B100")) Is Nothing Then
      Sh.Tab.Color = Target.DisplayFormat.Interior.Color
   End If
End Sub

 

[JanHereOpera]

It works beautifuly!!!! Thank you so much for your help! Really appreciate it!

 

[Fluff]

Glad we could help & thanks for the feedback.