Works Perfectly. More coffee consumed and all is well!!
I have changed the code a bit.
I have now got three different colour events. I have three sheets called PLANNED, IN-BUILD and COMPLETE. Each job card (or Sheet) has a field to change the status to one of these three mentioned. I put a code in the job card sheets that changes the tab colour depending on the value of this cell. So if the status is PLANNED the tab changes to red and appears as a hyperlink on the PLANNED Jobs Sheet. Works really great. Thanks!! oh and I have changed the link created in the sheets to be in the cell I want it to be, although it is not really needed as the job cards have a return home button.
I have tried to combine the three different codes into one sheet. (To add a clarifying statement. in altering the code each "STATUS" list appears in different columns now. EG PLANNED in Column B, IN-BUILD in Column D and COMPLETE in column F) The problem is They are all called "Private sub Worksheet_Activate ()" I now understand why but I don't know how to get them to all work on one sheet.
Here are the three lumps of code running really well on individual sheets.
CODE 1
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim n As Integer
Dim calcState As Long, scrUpdateState As Long
calcState = Application.Calculation
Application.Calculation = xlCalculationManual
scrUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False
n = 2
With Me
.Columns(2).ClearContents
.Cells(2, 2) = "PLANNED"
.Cells(1, 2).Name = "Index"
End With
For Each wSheet In Worksheets
If wSheet.Name <> Me.Name And wSheet.Tab.Color = vbRed Then
n = n + 1
With wSheet
.Range("A1").Name = "Start_" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1000"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With
Me.Hyperlinks.Add Anchor:=Me.Cells(n, 2), Address:="", _
SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState
End Sub
CODE 2
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim n As Integer
Dim calcState As Long, scrUpdateState As Long
calcState = Application.Calculation
Application.Calculation = xlCalculationManual
scrUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False
n = 2
With Me
.Columns(4).ClearContents
.Cells(2, 4) = "IN-BUILD"
.Cells(4, 4).Name = "Index"
End With
For Each wSheet In Worksheets
If wSheet.Name <> Me.Name And wSheet.Tab.Color = vbGreen Then
n = n + 1
With wSheet
.Range("A1").Name = "Start_" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1000"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With
Me.Hyperlinks.Add Anchor:=Me.Cells(n, 4), Address:="", _
SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState
End Sub
CODE 3
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim n As Integer
Dim calcState As Long, scrUpdateState As Long
calcState = Application.Calculation
Application.Calculation = xlCalculationManual
scrUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False
n = 2
With Me
.Columns(6).ClearContents
.Cells(2, 6) = "COMPLETE"
.Cells(1, 6).Name = "Index"
End With
For Each wSheet In Worksheets
If wSheet.Name <> Me.Name And wSheet.Tab.Color = vbBlue Then
n = n + 1
With wSheet
.Range("A1").Name = "Start_" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1000"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With
Me.Hyperlinks.Add Anchor:=Me.Cells(n, 6), Address:="", _
SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState
End Sub
Is there a way to get all these to run on the one worksheet. The guys only need to look at one sheet to see the jobs in different status then.
Thanks
Jason Bing
PS. I really do appreciate this.
Thanks
