Dynamic list of worksheets based on tab colour

J

JasonBing

New Member
Joined
Aug 6, 2019
Messages
49
I have a workbook with about 16 admin and finance sheets. Then the rest of sheets contain the data for each job, like job cards. These sheets are coloured blue and the admin sheets are coloured green. I have been asked to create another admin sheet with a dynamic list of sheet names with hyperlinks. But they only want the blue sheets to be shown on this list, so they can easily navigate to the job cards to update them.

I am stumped.

Any help would be greatly appreciated.

Thanks

Jason Bing
 
Sort by date Sort by votes

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
JasonBing said:
WOW That seems simpler

The job status is recorded in cell "Y2"

Thanks Again

Regards

Jason Bing
Click to expand...
Create a sheet named "INDEX" then select any other sheet and then INDEX again and see if this does what you want.
Code: 
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim calcState As Long, scrUpdateState As Long
Dim Status As String, NxRw As Long

calcState = Application.Calculation
Application.Calculation = xlCalculationManual
scrUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False

    With Me
        .Cells.ClearContents
        .Cells(2, 2) = "PLANNED"
        .Cells(2, 4) = "IB-BUILD"
        .Cells(2, 6) = "COMPLETE"
    End With
    
    For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name And wSheet.Range("Y2") <> "" Then
            Status = wSheet.Range("Y2")
            Select Case Status
                Case "PLANNED"
                NxRw = Me.Cells(Rows.Count, "B").End(xlUp).Row + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With
                Me.Hyperlinks.Add Anchor:=Me.Cells(NxRw, "B"), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Case "IB-BUILD"
                NxRw = Me.Cells(Rows.Count, "D").End(xlUp).Row + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With
                Me.Hyperlinks.Add Anchor:=Me.Cells(NxRw, "D"), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Case "COMPLETE"
                NxRw = Me.Cells(Rows.Count, "F").End(xlUp).Row + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With
                Me.Hyperlinks.Add Anchor:=Me.Cells(NxRw, "F"), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Case Else
                MsgBox "There is a problem with worksheet " & wSheet.Name & " please check the Status cell on that sheet."
            End Select
        End If
    Next wSheet
    Me.UsedRange.Columns.AutoFit
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState
End Sub
 
Last edited:
Upvote 0
Oops, forgot to name a cell in the INDEX sheet so the return links work. Scrap the code in post #12 for this (goes into the INDEX sheet).
Code: 
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim calcState As Long, scrUpdateState As Long
Dim Status As String, NxRw As Long

calcState = Application.Calculation
Application.Calculation = xlCalculationManual
scrUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False

    With Me
        .Cells(1, 1).Name = "Index"
        .Cells.ClearContents
        .Cells(2, 2) = "PLANNED"
        .Cells(2, 4) = "IB-BUILD"
        .Cells(2, 6) = "COMPLETE"
    End With
    
    For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name And wSheet.Range("Y2") <> "" Then
            Status = wSheet.Range("Y2")
            Select Case Status
                Case "PLANNED"
                NxRw = Me.Cells(Rows.Count, "B").End(xlUp).Row + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With
                Me.Hyperlinks.Add Anchor:=Me.Cells(NxRw, "B"), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Case "IB-BUILD"
                NxRw = Me.Cells(Rows.Count, "D").End(xlUp).Row + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With
                Me.Hyperlinks.Add Anchor:=Me.Cells(NxRw, "D"), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Case "COMPLETE"
                NxRw = Me.Cells(Rows.Count, "F").End(xlUp).Row + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With
                Me.Hyperlinks.Add Anchor:=Me.Cells(NxRw, "F"), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Case Else
                MsgBox "There is a problem with worksheet " & wSheet.Name & " please check the Status cell on that sheet."
            End Select
        End If
    Next wSheet
    Me.UsedRange.Columns.AutoFit
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState
End Sub
 
Last edited:
Upvote 0
Mate. Your are a legend. The code works perfectly. I did add a few lines to unprotect and protect the sheet (I forgot to mention the sheets were protected) but in is exactly what I needed.


Thank you soooo much mate you have made my life a lot easier.


The guys appreciate it too

Regards

Jason Bing
 
Upvote 0
There is one small niggle. I do feel a bit picky asking. But is there a way to prevent the refresh from resetting the format. The guys use a touch screen with this workbook and the small format prevents them activating the hyperlink with their fat fingers!!:laugh:

I do feel like I am being picky though! I don't want it to feel like I am unappreciative.

Thanks

Jason Bing
 
Upvote 0
JasonBing said:
Mate. Your are a legend. The code works perfectly. I did add a few lines to unprotect and protect the sheet (I forgot to mention the sheets were protected) but in is exactly what I needed.


Thank you soooo much mate you have made my life a lot easier.


The guys appreciate it too

Regards

Jason Bing
Click to expand...
You are welcome - thanks for the reply.
 
Upvote 0
JasonBing said:
There is one small niggle. I do feel a bit picky asking. But is there a way to prevent the refresh from resetting the format. The guys use a touch screen with this workbook and the small format prevents them activating the hyperlink with their fat fingers!!:laugh:

I do feel like I am being picky though! I don't want it to feel like I am unappreciative.

Thanks

Jason Bing
Click to expand...
I assume your talking about the INDEX sheet. Tell me what formatting you want (Font name(s)/size(s), .....etc) and where you want it, and I'll add it.
 
Upvote 0
Thank you.

The colour formatting is fine, it is controlled by a conditional format and works well

The Font name I need is Arial

And the font size I would love to be 28. We use a touch screen with this workbook and the guys have fat fingers:laugh:

Thanks mate for your help

Regards

Jason Bing
 
Upvote 0
JasonBing said:
Thank you.

The colour formatting is fine, it is controlled by a conditional format and works well

The Font name I need is Arial

And the font size I would love to be 28. We use a touch screen with this workbook and the guys have fat fingers:laugh:

Thanks mate for your help

Regards

Jason Bing
Click to expand...
Replace prior code with this:
Code: 
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim calcState As Long, scrUpdateState As Long
Dim Status As String, NxRw As Long

calcState = Application.Calculation
Application.Calculation = xlCalculationManual
scrUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False

    With Me
        .Cells(1, 1).Name = "Index"
        .Cells.ClearContents
        .Cells(2, 2) = "PLANNED"
        .Cells(2, 4) = "IB-BUILD"
        .Cells(2, 6) = "COMPLETE"
    End With
    
    For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name And wSheet.Range("Y2") <> "" Then
            Status = wSheet.Range("Y2")
            Select Case Status
                Case "PLANNED"
                NxRw = Me.Cells(Rows.Count, "B").End(xlUp).Row + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With
                Me.Hyperlinks.Add Anchor:=Me.Cells(NxRw, "B"), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Case "IB-BUILD"
                NxRw = Me.Cells(Rows.Count, "D").End(xlUp).Row + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With
                Me.Hyperlinks.Add Anchor:=Me.Cells(NxRw, "D"), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Case "COMPLETE"
                NxRw = Me.Cells(Rows.Count, "F").End(xlUp).Row + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                End With
                Me.Hyperlinks.Add Anchor:=Me.Cells(NxRw, "F"), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Case Else
                MsgBox "There is a problem with worksheet " & wSheet.Name & " please check the Status cell on that sheet."
            End Select
        End If
    Next wSheet
    With Me.UsedRange
        With .Font
            .Name = "Arial"
            .Size = 28
        End With
        .Columns.AutoFit
    End With
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
VBA to edit/update cells within a large table from a common "Dashboard"
Replies
1
Views
460
brianv
B
F
  • Question Question
Conditional Format multiple worksheet tabs color based on a date in each sheet
Replies
7
Views
1K
kevin9999
K
E
  • Question Question
Write formula to compare planned amounts by vendor in one sheet to approved amounts by vendor in another tab based on project ID
Replies
1
Views
544
OaklandJim
O
D
  • Question Question
VBA code to change tab colours based on cell with formula on each sheet (60 sheets)
Replies
6
Views
552
Georgiboy
Georgiboy
E
  • Question Question
Search box to hide row that don't contain but also not to show cell that contain different than search box.
Replies
0
Views
595
Excel2022
E

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top