Dynamically change specific tab colors using a row of cells from one sheet

[rdoulaghsingh]

I have a workbook with about 65 tabs/sheets. I have one specific worksheet named "CONTENTS" with a status column with dropdowns for "Not started", "Incomplete" and "Completed". Based on the dropdown value in a range of cell from D3:D58 on the sheet named "CONTENTS", I need the tab color matching the name of the A Column starting at row 3 to 58 to update with the selection. I know how to accomplish this doing it one by one with the code below, but I'm looking for a loop which can use the status from D3:D58 on the CONTENTS sheet to update each corresponding sheet. Here's the other kicker...I have a few buttons on another page to remove rows and sheets depending on the project type. So the code cannot be absolute and tied to a specific cell. So the code below wouldn't exactly work since the text "Introduction to 800-171" might not be the value of that cell if it got deleted. Please help!

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Select Case Sheets("CONTENTS").Range("D3").Value
Case "Not Started"
Sheets("Introduction 800-171").Tab.color = vbRed
Case "Incomplete"
Sheets("Introduction 800-171").Tab.color = vbYellow
Case "Completed"
Sheets("Introduction 800-171").Tab.color = RGB(0, 120, 60)
End Select
End Sub

 

[Norie]

Where are the sheet names on 'CONTENTS'?

 

[Fluff]

Hi & welcome to MrExcel.
How about

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Clr As Long
   
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("D3:D500")) Is Nothing Then
      If Target.Value <> "" Then
         Select Case Target.Value
            Case "Not Started": Clr = 255
            Case "Incomplete": Clr = 65535
            Case "Completed": Clr = 3962880
         End Select
         Sheets(Target.Offset(, -3).Value).Tab.Color = Clr
      End If
   End If
End Sub

This needs to go in the Contents sheet module.

 

[rdoulaghsingh]

Hi & welcome to MrExcel.
How about

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Clr As Long
  
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("D3:D500")) Is Nothing Then
      If Target.Value <> "" Then
         Select Case Target.Value
            Case "Not Started": Clr = 255
            Case "Incomplete": Clr = 65535
            Case "Completed": Clr = 3962880
         End Select
         Sheets(Target.Offset(, -3).Value).Tab.Color = Clr
      End If
   End If
End Sub

This needs to go in the Contents sheet module.

Thanks for the swift response. I tried the code and this is the furthest I've gotten so far, so thank you for all your help. I am; however, receiving a runtime error '9' - Subscript out of range on line "Sheets(Target.Offset(, -3).Value).Tab.color = Clr" when I run the code.

 

[rdoulaghsingh]

Where are the sheet names on 'CONTENTS'?

The sheet names are located in columns A3-A58. The names may move from cell to cell because of the buttons I have for removing unwanted sheets which also removes their cell reference from CONTENTS sheet.

 

[Fluff]

Maybe

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Clr As Long

   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("D3:D500")) Is Nothing Then
      If Target.Value <> "" Then
         If Evaluate("isref('" & Target.Offset(, -3).Value & "'!A1)") Then
            Select Case Target.Value
               Case "Not Started": Clr = 255
               Case "Incomplete": Clr = 65535
               Case "Completed": Clr = 3962880
            End Select
            Sheets(CStr(Target.Offset(, -3).Value)).Tab.Color = Clr
         Else
            MsgBox "Sheet " & Target.Offset(, -3).Value & " doesn't exist"
         End If
      End If
   End If
End Sub

 

[rdoulaghsingh]

Maybe

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Clr As Long

   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("D3:D500")) Is Nothing Then
      If Target.Value <> "" Then
         If Evaluate("isref('" & Target.Offset(, -3).Value & "'!A1)") Then
            Select Case Target.Value
               Case "Not Started": Clr = 255
               Case "Incomplete": Clr = 65535
               Case "Completed": Clr = 3962880
            End Select
            Sheets(CStr(Target.Offset(, -3).Value)).Tab.Color = Clr
         Else
            MsgBox "Sheet " & Target.Offset(, -3).Value & " doesn't exist"
         End If
      End If
   End If
End Sub

Hmmm...Now I'm getting a runtime 13 - Type mismatch. The funny thing is it does change the tab colors when I change the dropdown, but the error persists whenever I change the dropdown.

 

[rdoulaghsingh]

Hmmm...Now I'm getting a runtime 13 - Type mismatch. The funny thing is it does change the tab colors when I change the dropdown, but the error persists whenever I change the dropdown.

Forgot to add the runtime error 13 is on line "If Evaluate("isref('" & Target.Offset(, -3).Value & "'!A1)") Then"

 

[Fluff]

Are your sheet names in col A?

 

[rdoulaghsingh]

Are your sheet names in col A?

The sheet names are in column A, but the dropdown to change the sheet names are in column D. I attached a screenshot so you can have an idea of how the sheet is setup.