Macro to change color of tab based on color of cell

[Amie]

Hello -

I would like to write a macro that will change the color of the
worksheet tab based on the color of cells. For example I have
conditional formating that will highlight cells in yellow. I want a
macro that says:

If cells in worksheet change to yellow
then
Change the tab to yellow

Can anyone help me with this?

 

[Mike]

Sub Macro1()
If Range("A1").Interior.Color = 65535 Then
With ActiveSheet.Tab
.Color = 65535
End With
End If
End Sub

 

[Mike]

paste this into the sheet you want the tab color to change
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1").Interior.Color = 65535 Then
With ActiveSheet.Tab
.Color = 65535
End With
Else
With ActiveSheet.Tab
.Color = 0
End With
End If
End Sub

 

[Amie]

paste this into the sheet you want the tab color to change
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Range("A1").Interior.Color = 65535 Then
    With ActiveSheet.Tab
        .Color = 65535
    End With
    Else
    With ActiveSheet.Tab
        .Color = 0
    End With
    End If
End Sub








- Show quoted text -

This is great thank you. Another question what if I want to say:

If any of the cells in the worksheet are colored yellow then color the
tab yellow? Here is the code that I have written but this is only
good for column 1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim iRow As Integer
iRow = 1

Do Until iRow = 300
If Cells(iRow, 1).Interior.Color = 65535 Then
With ActiveSheet.Tab
.Color = 65535
End With
Exit Do
Else
With ActiveSheet.Tab
.Color = 0
End With
End If
iRow = iRow + 1

Loop

End Sub

 

[Amie]

This is great thank you. Another question what if I want to say:

If any of the cells in the worksheet are colored yellow then color the
tab yellow? Here is the code that I have written but this is only
good for column 1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim iRow As Integer
iRow = 1

Do Until iRow = 300
If Cells(iRow, 1).Interior.Color = 65535 Then
With ActiveSheet.Tab
.Color = 65535
End With
Exit Do
Else
With ActiveSheet.Tab
.Color = 0
End With
End If
iRow = iRow + 1

Loop

End Sub

 

[Mike]

I guess you could do another loop but checking each cell will greatly
so down performance. Maybe someone else has a better idea for you.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim iRow As Integer
Dim iColumn As Integer

iColumn = 1
Do Until iColumn > 3
iRow = 1
Do Until iRow > 300
If Cells(iRow, iColumn).Interior.Color = 65535 Then
With ActiveSheet.Tab
.Color = 65535
End With
Exit Do
Else
With ActiveSheet.Tab
.Color = 0
End With
End If
iRow = iRow + 1
Loop
iColumn = iColumn + 1
Loop
End Sub