Change tab color based on a cell value

[Zenaida]

Does anyone know what code I would use in the worksheet event to chang
the tab color of all 6 worksheets in my workbook based off a value in
cell?

I would like all 6 tabs to be red if there is any value in cell V1 o
worksheet 1. If cell V1 is empty I don't want any tab color.

I'm also not sure how to reference worksheet 1 in the code because th
name of it changes depending on what's in two other cells of th
worksheet.

This is the code I have right now in the worksheet event.


Code
-------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim i As Long

If InStr(Target.Address, "$A$7") <> 0 Or InStr(Target.Address, "$A$8") <> 0 Then
For Each ws In Worksheets
i = i + 1
On Error Resume Next
If Not IsDate(Range("A7")) Then
ws.Name = "Cert Period " & i
Else
ws.Name = Format(ws.Range("A7"), "m-dd-yy") & " THRU " & Format(ws.Range("F7"), "m-dd-yy")
End If
If Err.Number <> 0 Then
MsgBox "Could not rename sheet " & ws.Name, vbCritical, "Renaming Error"
Err.Clear
End If
Next ws
End If
End Su
-------------------


(FYI - cells A7 & F7 are merged cells.)

Any help is greatly appreciated. Thanks

+-------------------------------------------------------------------
|Filename: Frequency Audit.zip
|Download: http://www.excelforum.com/attachment.php?postid=4696
+-------------------------------------------------------------------

 

[Dave Peterson]

Could you use worksheets(1)?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim i As Long

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("a7:a8")) Is Nothing Then Exit Sub

For Each ws In Worksheets
i = i + 1
On Error Resume Next
'did you mean ws.range("a7")
'or me.range("a7")
If IsDate(ws.Range("A7")) Then
ws.Name = Format(ws.Range("A7"), "m-dd-yy") _
& " THRU " & Format(ws.Range("F7"), "m-dd-yy")
Else
ws.Name = "Cert Period " & i
End If
If Err.Number <> 0 Then
MsgBox "Could not rename sheet " & ws.Name, vbCritical, _
"Renaming Error"
Err.Clear
End If
If Me.Parent.Worksheets(1).Range("a7") = "" Then
'do nothing
Else
ws.Tab.ColorIndex = 3
End If
Next ws

End Sub

I (arbitrarily) changed a couple of things. You can change them back if you
don't like them.

I find this more difficult to understand:
If InStr(Target.Address, "$A$7") <> 0 Or InStr(Target.Address, "$A$8") <> 0 Then
than:
If Intersect(Target, Me.Range("a7:a8")) Is Nothing Then Exit Sub

And instead of checking the negative, I like to check the positive. But that
means the Then portion and the Else portion have to swap locations:

If Not IsDate(Range("A7")) Then
ws.Name = "Cert Period " & i
Else
ws.Name = Format(ws.Range("A7"), "m-dd-yy") _
& " THRU " & Format(ws.Range("F7"), "m-dd-yy")
End If

becomes

If IsDate(ws.Range("A7")) Then
ws.Name = Format(ws.Range("A7"), "m-dd-yy") _
& " THRU " & Format(ws.Range("F7"), "m-dd-yy")
Else
ws.Name = "Cert Period " & i
End If

 

[Zenaida]

Thanks for your help on the code. The tab coloring isn't quite right.
No matter what I have in the cell, all the tabs are red. Any ideas?

 

[Dave Peterson]

This is the portion that does the checking/work:

If Me.Parent.Worksheets(1).Range("a7") = "" Then
'do nothing
Else
ws.Tab.ColorIndex = 3
End If

What's in the leftmost worksheet in cell A7?

As long as there's something in it, the tab color will be red.

 

[Zenaida]

I'm not sure what you mean when you ask . . . . What's in the leftmost
worksheet in cell A7?

I tried using your code but it doesn't work with the names of the
sheets with Cert Period & i when cell A7 is blank. I inserted your
part of the code with the coloring of the tabs and then I made some
changes but I keep getting the same result that all the tabs are
colored when I use your code and when I made the change.

The cell I want to base coloring or not coloring the tabs is cell V1.
FYI - if cell V1 in the first worksheet has a value in it, that value
is copied to cell V1 of the rest of the worksheets. So it doesn't
matter which worksheet is referenced, if there's a value in cell V1 of
any of the worksheets, I want all tabs to be red. If cell V1 of any of
the worksheets is empty, I want all the tabs to not be colored.


Code:
--------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim i As Long

If InStr(Target.Address, "$A$7") <> 0 Or InStr(Target.Address, "$A$8") <> 0 Then
For Each ws In Worksheets
i = i + 1
On Error Resume Next
If Not IsDate(Range("A7")) Then
ws.Name = "Cert Period " & i
Else
ws.Name = Format(ws.Range("A7"), "m-dd-yy") & " THRU " & Format(ws.Range("F7"), "m-dd-yy")
End If
If Err.Number <> 0 Then
MsgBox "Could not rename sheet " & ws.Name, vbCritical, "Renaming Error"
Err.Clear
End If
If Not IsDate(Range("V1")) Then
ws.Tab.ColorIndex = -xlColorIndexAutomatic
Else
ws.Tab.ColorIndex = 3
End If
Next ws

End If
End Sub
--------------------


Cell V1 is not merged. It's formatted with a date format. I'm not
sure what the problem could be.

 

[Dave Peterson]

I messed up when I used A7. It should have been V1.

If Me.Parent.Worksheets(1).Range("a7") = "" Then
ws.tab.colorindex = xlNone
Else
ws.Tab.ColorIndex = 3
End If

 

[Zenaida]

I did notice you used A7 instead of V1. I changed a7 to v1 in the code
and when v1 is empty, nothing happens, when v1 has a date in it,
nothing happens.

If I leave a7 in the code instead of v1 and enter a date in a7, all the
tabs will turn red, when I remove the date from a7, all the tabs have no
color - which is really great but why can't I change the code to v1 and
have it work the way it does with a7?

 

[Dave Peterson]

It looks like you used a cross between the code I suggested and your existing
code. How about just trying the code I suggested (with the A7/V1 change) and
see what happens?

 

[Zenaida]

When I use your code exactly how you have it with the a7/v1 conversion,
nothing happens. The tabs don't change color with a value in v1 and
they don't change when v1 is empty.

 

[Dave Peterson]

Please post the code you tried that failed.

When I use your code exactly how you have it with the a7/v1 conversion,
nothing happens. The tabs don't change color with a value in v1 and
they don't change when v1 is empty.

 

[Zenaida]

I copied the code and changed the a7/v1 reference but I couldn't get it
to color the tabs.


Code:
--------------------
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim i As Long

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("a7:a8")) Is Nothing Then Exit Sub

For Each ws In Worksheets
i = i + 1
On Error Resume Next
'did you mean ws.range("a7")
'or me.range("a7")
If IsDate(ws.Range("A7")) Then
ws.Name = Format(ws.Range("A7"), "m-dd-yy") _
& " THRU " & Format(ws.Range("F7"), "m-dd-yy")
Else
ws.Name = "Cert Period " & i
End If
If Err.Number <> 0 Then
MsgBox "Could not rename sheet " & ws.Name, vbCritical, _
"Renaming Error"
Err.Clear
End If
If Me.Parent.Worksheets(1).Range("v1") = "" Then
'do nothing
Else
ws.Tab.ColorIndex = 3
End If
Next ws

End Sub

 

[Dave Peterson]

You didn't include the code to change the .colorindex back if V1 was empty. But
this code worked fine for me:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim i As Long

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("a7:a8")) Is Nothing Then Exit Sub

For Each ws In Worksheets
i = i + 1
On Error Resume Next
'did you mean ws.range("a7")
'or me.range("a7")
If IsDate(ws.Range("A7")) Then
ws.Name = Format(ws.Range("A7"), "m-dd-yy") _
& " THRU " & Format(ws.Range("F7"), "m-dd-yy")
Else
ws.Name = "Cert Period " & i
End If
If Err.Number <> 0 Then
MsgBox "Could not rename sheet " & ws.Name, vbCritical, _
"Renaming Error"
Err.Clear
End If
If Me.Parent.Worksheets(1).Range("v1") = "" Then
ws.Tab.ColorIndex = xlNone '<--- Added
Else
ws.Tab.ColorIndex = 3
End If
Next ws

End Sub

Are you sure you put it in the correct location--in the worksheet module that
owns the A7:A8 that you want to monitor?

 

[Zenaida]

If it's working fine for you then it must be something with the layout
of my spreadsheet. I un-merged v1. I copied the code how you wrote it
in your recent post and I still couldn't get it to work.

So far doing the code separately how I posted in post #9 seems to be
working.

Thanks for all your time.

 

[Dave Peterson]

Merged cells can cause many problems. I try to avoid them unless I absolutely
have to use them.

 

[Zenaida]

I'm forcing myself out of that bad habit of merging cells. Thanks again
for all your help.