View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson
 
Posts: n/a
Default Change tab color based on a cell value

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 wrote:

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

I would like all 6 tabs to be red if there is any value in cell V1 of
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 the
name of it changes depending on what's in two other cells of the
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 Sub
--------------------

(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 |
+-------------------------------------------------------------------+

--
Zenaida

------------------------------------------------------------------------
Zenaida's Profile: http://www.excelforum.com/member.php...o&userid=33802
View this thread: http://www.excelforum.com/showthread...hreadid=536203


--

Dave Peterson