Exclude Very Hidden Worksheets from Menu / Index of All Sheets

B

BDM AT WCS

New Member
Joined
Dec 17, 2018
Messages
7
I've got a Workbook report that pulls 'raw' source data in via MS Query. I don't want the report recipients to see this RAW DATA and also some other 'helper' worksheets so I've set those to be VeryHidden. Since there are a large number of other visible sheets, I've copied a macro which produces a list of all sheets, assigns an index number to them and creates hyperlinks for each to quickly navigate around the workbook and reproduces the worksheet colour in the next column. But this macro includes ALL worksheets and I would like to exclude the VeryHidden sheets from the menu. Can anyone help?

VBA Code: 
Sub MenuOfSheetsByTab()

'Go to the "menu" worksheet
Sheets("menu").Select
'list all sheets in active workbook
Dim wb As Workbook
Dim ws As Worksheet
Dim wsM As Worksheet
Dim lColorC As Long 'cell color
Dim lColorT As Long 'tab color
Dim lRow As Long
Dim lRowHead As Long
Dim lCol As Long
Dim lCols As Long
Dim lColEnd As Long
Dim lSh As Long
On Error Resume Next

Application.ScreenUpdating = False
Application.EnableEvents = False

Set wb = ActiveWorkbook
Set wsM = Worksheets("menu")
lRowHead = 1
lCol = 1
lCols = 2
lColEnd = lCol + lCols - 1
lRow = lRowHead + 1

With wsM.Range(wsM.Cells(lRowHead, lCol), _
    wsM.Cells(lRowHead, lColEnd))
  .EntireColumn.Clear
  .Value = Array("ID", "Sheet")
End With

With wsM
  For Each ws In wb.Worksheets
    .Range(.Cells(lRow, lCol), _
      .Cells(lRow, lColEnd - 1)).Value _
      = Array(lRow - lRowHead, ws.Name)
      If ws.Tab.ColorIndex = -4142 Then
        .Cells(lRow, lColEnd) _
          .Interior.ColorIndex _
          = ws.Tab.ColorIndex

      Else
        .Cells(lRow, lColEnd) _
          .Interior.Color _
          = ws.Tab.Color
      End If

'add hyperlink to sheet name
      .Hyperlinks.Add _
          Anchor:=.Cells(lRow, lCol + 1), _
          Address:="", _
          SubAddress:="'" & ws.Name & "'!A1", _
          ScreenTip:=ws.Name, _
          TextToDisplay:=ws.Name
    lRow = lRow + 1
  Next ws

  With .Range(.Cells(lRowHead, lCol), _
      .Cells(lRowHead, lColEnd))
    .Font.Bold = True
    .EntireColumn.AutoFit

End With
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Sort by date Sort by votes
Code: 
With wsM
  For Each ws In wb.Worksheets
    If ws.Visible <> xlVeryHidden then
     ... rest of code...
    End If
  Next ws
End With
 
Upvote 0
Thanks for your lighting fast response Oaktree. It took me a bit of time to figure out where this code needs to be inserted into the whole macro but I got there in the end :biggrin:
One thing though, the way I got it to work was to insert your suggested "Next ws" AFTER your "End with". I've inserted comments into the code for others to follow...
I think there may be some superfluous " With wsM" and "End With" in my version so smarter / more experienced minds could render a version with cleaner code, but this works. It could well be that I've not inserted Oaktree's code where he'd intended I should so maybe he got the "Next ws" and "End with" in the right order and that's why I've ended up with some additional and perhaps unnecessary code.

VBA Code: 
Sub MenuOfSheetsByTab()
'Go to the "menu" tab
    Sheets("menu").Select

'list all sheets in active workbook
Dim wb As Workbook
Dim ws As Worksheet
Dim wsM As Worksheet
Dim lColorC As Long 'cell color
Dim lColorT As Long 'tab color
Dim lRow As Long
Dim lRowHead As Long
Dim lCol As Long
Dim lCols As Long
Dim lColEnd As Long
Dim lSh As Long
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False

Set wb = ActiveWorkbook
Set wsM = Worksheets("menu")
lRowHead = 1
lCol = 1
lCols = 3
lColEnd = lCol + lCols - 1
lRow = lRowHead + 1

With wsM.Range(wsM.Cells(lRowHead, lCol), _
    wsM.Cells(lRowHead, lColEnd))
  .EntireColumn.Clear
  .Value = Array("ID", "Sheet", "Tab Colour")
End With
      
'start of Oaktree's solution

With wsM
  For Each ws In wb.Worksheets
  With wsM
    If ws.Visible <> xlVeryHidden Then

'here is where Oaktree's "...rest of code..." starts

    .Range(.Cells(lRow, lCol), _
      .Cells(lRow, lColEnd - 1)).Value _
      = Array(lRow - lRowHead, ws.Name)
      If ws.Tab.ColorIndex = -4142 Then
        .Cells(lRow, lColEnd) _
          .Interior.ColorIndex _
          = ws.Tab.ColorIndex
      Else
        .Cells(lRow, lColEnd) _
          .Interior.Color _
          = ws.Tab.Color
      End If


      'add hyperlink to sheet name
      .Hyperlinks.Add _
          Anchor:=.Cells(lRow, lCol + 1), _
          Address:="", _
          SubAddress:="'" & ws.Name & "'!A1", _
          ScreenTip:=ws.Name, _
          TextToDisplay:=ws.Name
    lRow = lRow + 1
    
'here is where Oaktree's solution starts to close
'The "End If" immediately below closes the original "If ws.Visible <> xlVeryHidden Then"
    End If
'The "End With" immediately below closes the original "With wsM"
    End With
'And then the code loops back via "Next ws" to look at the next worksheet in sequence. If it's not equal to VeryHidden (<> xlVeryHidden) then it applies the code in between to the visible worksheet
  Next ws
 
  With .Range(.Cells(lRowHead, lCol), _
      .Cells(lRowHead, lColEnd))
    .Font.Bold = True
    .EntireColumn.AutoFit
  End With
End With
 
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
Upvote 0
You don't need the 2nd With, as it's redundant with the 1st:

Code: 
Sub MenuOfSheetsByTab()
'Go to the "menu" tab
    Sheets("menu").Select

'list all sheets in active workbook
Dim wb As Workbook
Dim ws As Worksheet
Dim wsM As Worksheet
Dim lColorC As Long 'cell color
Dim lColorT As Long 'tab color
Dim lRow As Long
Dim lRowHead As Long
Dim lCol As Long
Dim lCols As Long
Dim lColEnd As Long
Dim lSh As Long
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False

Set wb = ActiveWorkbook
Set wsM = Worksheets("menu")
lRowHead = 1
lCol = 1
lCols = 3
lColEnd = lCol + lCols - 1
lRow = lRowHead + 1

With wsM.Range(wsM.Cells(lRowHead, lCol), _
    wsM.Cells(lRowHead, lColEnd))
  .EntireColumn.Clear
  .Value = Array("ID", "Sheet", "Tab Colour")
End With
      
'start of Oaktree's solution

With wsM
  For Each ws In wb.Worksheets
    If ws.Visible <> xlVeryHidden Then

'here is where Oaktree's "...rest of code..." starts

    .Range(.Cells(lRow, lCol), _
      .Cells(lRow, lColEnd - 1)).Value _
      = Array(lRow - lRowHead, ws.Name)
      If ws.Tab.ColorIndex = -4142 Then
        .Cells(lRow, lColEnd) _
          .Interior.ColorIndex _
          = ws.Tab.ColorIndex
      Else
        .Cells(lRow, lColEnd) _
          .Interior.Color _
          = ws.Tab.Color
      End If

      'add hyperlink to sheet name
      .Hyperlinks.Add _
          Anchor:=.Cells(lRow, lCol + 1), _
          Address:="", _
          SubAddress:="'" & ws.Name & "'!A1", _
          ScreenTip:=ws.Name, _
          TextToDisplay:=ws.Name
    lRow = lRow + 1
    
'here is where Oaktree's solution starts to close
'The "End If" immediately below closes the original "If ws.Visible <> xlVeryHidden Then"
    End If
'And then the code loops back via "Next ws" to look at the next worksheet in sequence. If it's not equal to VeryHidden (<> xlVeryHidden) then it applies the code in between to the visible worksheet
  Next ws
 
  With .Range(.Cells(lRowHead, lCol), _
      .Cells(lRowHead, lColEnd))
    .Font.Bold = True
    .EntireColumn.AutoFit
  End With
End With
 
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
Upvote 0
Solution
I commented out the 2nd End With rather than deleting. I then got a "Next without For" compile error as commented into the code below

VBA Code: 
'here is where Oaktree's solution starts to close
'The "End If" immediately below closes the original "If ws.Visible <> xlVeryHidden Then"
    End If
'The "End With" immediately below closes the original "With wsM"
'commented out the 2nd end "End With" here....and got a compile error at Next ws
'And then the code loops back via "Next ws" to look at the next worksheet in sequence. If it's not equal to VeryHidden (<> xlVeryHidden) then it applies the code to the visible worksheet
  Next ws
'"Next without For" Compile error here'
 
Upvote 0
Did you also comment out the 2nd "With ws"? The code in my previous post removed both the 2nd "With ws" and its corresponding "End with". If you left one but not the other, it will error out.
 
Upvote 0
You nailed it Oaktree! Thanks for your help today. Awesome!

VBA Code: 
Sub MenuOfSheetsByTab()

'Go to the "menu" tab
    Sheets("menu").Select
'list all sheets in active workbook

Dim wb As Workbook
Dim ws As Worksheet
Dim wsM As Worksheet
Dim lColorC As Long 'cell color
Dim lColorT As Long 'tab color
Dim lRow As Long
Dim lRowHead As Long
Dim lCol As Long
Dim lCols As Long
Dim lColEnd As Long
Dim lSh As Long
On Error Resume Next

Application.ScreenUpdating = False
Application.EnableEvents = False

Set wb = ActiveWorkbook
Set wsM = Worksheets("menu")

lRowHead = 1
lCol = 1
lCols = 3
lColEnd = lCol + lCols - 1
lRow = lRowHead + 1

With wsM.Range(wsM.Cells(lRowHead, lCol), _
    wsM.Cells(lRowHead, lColEnd))
  .EntireColumn.Clear
  .Value = Array("ID", "Sheet", "Tab Colour")
End With

'start of Oaktree's solution

With wsM

  For Each ws In wb.Worksheets
    If ws.Visible <> xlVeryHidden Then

'here is where Oaktree's "...rest of code..." starts

    .Range(.Cells(lRow, lCol), _
      .Cells(lRow, lColEnd - 1)).Value _
      = Array(lRow - lRowHead, ws.Name)
      If ws.Tab.ColorIndex = -4142 Then
        .Cells(lRow, lColEnd) _
          .Interior.ColorIndex _
          = ws.Tab.ColorIndex
      Else
        .Cells(lRow, lColEnd) _
          .Interior.Color _
          = ws.Tab.Color
      End If

      'add hyperlink to sheet name

      .Hyperlinks.Add _
          Anchor:=.Cells(lRow, lCol + 1), _
          Address:="", _
          SubAddress:="'" & ws.Name & "'!A1", _
          ScreenTip:=ws.Name, _
          TextToDisplay:=ws.Name
    lRow = lRow + 1

'here is where Oaktree's solution starts to close

'The "End If" immediately below closes the original "If ws.Visible <> xlVeryHidden Then"
    End If

'And then the code loops back via "Next ws" to look at the next worksheet in sequence. If it's not equal to VeryHidden (<> xlVeryHidden) then it applies the code to the visible worksheet
  Next ws

'...this "With" and "End With" below was in the original macro
  With .Range(.Cells(lRowHead, lCol), _
      .Cells(lRowHead, lColEnd))
    .Font.Bold = True
    .EntireColumn.AutoFit
  End With

'...and here is Oaktree's final "End With" to close out the "With wsM" at the start of his solution
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Solved
Help with VBA modification
2
Replies
10
Views
635
Burrgogi
Burrgogi
T
  • Question Question
Additional cells are copied when I didn't select them
Replies
7
Views
273
smozgur
smozgur
E
  • Solved
This Code fills in below current month.
Replies
2
Views
181
Eric Penfold
E
JeffGrant
  • Solved
VBA Code used twice, keeps table formatting on one sheet, but not on the other
Replies
4
Views
436
smozgur
smozgur
E
  • Question Question
Trying to use index match method
Replies
7
Views
734
RoryA
RoryA

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

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