VBA to Dynamically list Worksheet Names

[MarkCBB]

Hi there,

I am looking for some VBA that can dynamically list all the names of the worksheets in a workbook (In Column A).
i.e. If I add a worksheet the name appears, if i edit the name the name is edited on the list and if I delete a worksheet the names is removed.

It doesn't need to be in order.

 

[JoeMo]

The hidden sheets aren't listed but neither are any of the other ones and I get a runtime error about the hyperlink range.

[COLOR=#333333][FONT=monospace][I].Hyperlinks.Add anchor:=.Range("A1"), Address:="", _SubAddress:="Collection", TextToDisplay:="Back to Collection"[/I][/FONT][/COLOR]

If I use the code in a blank workbook and move over the other sheets one by one everything works great until I add the Master sheet.
****** id="cke_pastebin" style="position: absolute; top: 0px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">.Hyperlinks.Add anchor:=.Range("A1"), Address:="", _ SubAddress:="Collection", TextToDisplay:="Back to Collection"

I can't reproduce your issue so have no way to help diagnose it. I've used this code in numerous workbooks for many years and have never had a problem with it. Do you have other event code in your workbook? What exactly is the run time error you are getting?

 

[BVavra]

There is other code in the workbook. I am getting run time error 1004 Application-defined or object-defined error. I have made a new workbook and migrated the formulas and code over because it is its infancy. Everything works as it should until I protect the "Master" sheet, the one I am hiding and using as a template.

 

[JoeMo]

There is other code in the workbook. I am getting run time error 1004 Application-defined or object-defined error. I have made a new workbook and migrated the formulas and code over because it is its infancy. Everything works as it should until I protect the "Master" sheet, the one I am hiding and using as a template.

Well, you didn't say anything about protecting the sheet. The macro can't write the return link to a cell on a protected sheet. I haven't tested this modification, but it should fix that piece after you supply your password in the two places highlighted in red. And, once again, I've left the part that excludes hidden sheets (also in red) remove it if you want to list a hidden sheet.

Private Sub Worksheet_Activate()
Dim wSheet As Worksheet, Protected As Boolean
Dim n As Integer
Dim calcState As Long, scrUpdateState As Long


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


n = 1


    With Me
        .Columns(1).ClearContents
        .Cells(1, 1) = "COLLECTION"
        .Cells(1, 1).Name = "Collection"
    End With
    
For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name And wSheet.Visible = xlSheetVisible Then
            n = n + 1
                With wSheet
                     If .Name = "Master" Then
                            .Unprotect Password:="your password between these quote marks"
                            Protected = True
                     Else
                            Protected = False
                     End If
                    .Range("A1").Name = "Start_" & wSheet.Index
                    .Hyperlinks.Add anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Collection", TextToDisplay:="Back to Collection"
                End With
                
                Me.Hyperlinks.Add anchor:=Me.Cells(n, 1), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                If Protected Then wSheet.Protect Password:="your password between these quote marks"
                
        End If
    Next wSheet
    
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState
End Sub

 

[BVavra]

I tried the code after entering my password and the same two lines of code are getting flagged.

 

[JoeMo]

I tried the code after entering my password and the same two lines of code are getting flagged.

And which two lines might those be?

 

[BVavra]

And which two lines might those be?

[COLOR=#333333]Private Sub Worksheet_Activate()[/COLOR]Dim wSheet As Worksheet, Protected As Boolean
Dim n As Integer
Dim calcState As Long, scrUpdateState As Long


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


n = 1


    With Me
        .Columns(1).ClearContents
        .Cells(1, 1) = "COLLECTION"
        .Cells(1, 1).Name = "Collection"
    End With
    
For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name And wSheet.Visible = xlSheetVisible Then
            n = n + 1
                With wSheet
                     If .Name = "Master" Then
                            .Unprotect Password:="your password between these quote marks"
                            Protected = True
                     Else
                            Protected = False
                     End If
                    .Range("A1").Name = "Start_" & wSheet.Index
                   [B][COLOR=#ff0000] .Hyperlinks.Add anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Collection", TextToDisplay:="Back to Collection"[/COLOR][/B]
                End With
                
                Me.Hyperlinks.Add anchor:=Me.Cells(n, 1), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                If Protected Then wSheet.Protect Password:="your password between these quote marks"
                
        End If
    Next wSheet
    
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState [COLOR=#333333]End Sub[/COLOR]

The two lines in red.

 

[JoeMo]

[COLOR=#333333]Private Sub Worksheet_Activate()[/COLOR]Dim wSheet As Worksheet, Protected As Boolean
Dim n As Integer
Dim calcState As Long, scrUpdateState As Long


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


n = 1


    With Me
        .Columns(1).ClearContents
        .Cells(1, 1) = "COLLECTION"
        .Cells(1, 1).Name = "Collection"
    End With
    
For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name And wSheet.Visible = xlSheetVisible Then
            n = n + 1
                With wSheet
                     If .Name = "Master" Then
                            .Unprotect Password:="your password between these quote marks"
                            Protected = True
                     Else
                            Protected = False
                     End If
                    .Range("A1").Name = "Start_" & wSheet.Index
                   [B][COLOR=#ff0000] .Hyperlinks.Add anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Collection", TextToDisplay:="Back to Collection"[/COLOR][/B]
                End With
                
                Me.Hyperlinks.Add anchor:=Me.Cells(n, 1), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                If Protected Then wSheet.Protect Password:="your password between these quote marks"
                
        End If
    Next wSheet
    
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState [COLOR=#333333]End Sub[/COLOR]

The two lines in red.

That's a single line. I can't reproduce your problem, whether or not I protect "Master"and whether or not "Master" is hidden. In post #22 you indicated there is other code in your workbook. Is it event code? Can you post it?

 

[BVavra]

That's a single line. I can't reproduce your problem, whether or not I protect "Master"and whether or not "Master" is hidden. In post #22 you indicated there is other code in your workbook. Is it event code? Can you post it?

Here is the other code in the workbook. I am building a workbook for my father to keep track of his antique gun collection. He is not too computer savvy so I am trying to make it as user-friendly as possible. I can send you the workbook if it would help.

Sub CreateNewGun() 'Creates new tab from protected MASTER tab
  
  
  Sheets("Collection").Select
    Sheets("MASTER").Visible = True


    NewName = InputBox("New Gun:")
    
If NewName = "" Then


    Sheets("MASTER").Visible = False
    
    Exit Sub
    End If
    
On Error GoTo MyError


ActiveWorkbook.Sheets("MASTER").Copy After:=Worksheets(5)
ActiveSheet.Name = NewName




    Sheets("MASTER").Select
    ActiveWindow.SelectedSheets.Visible = False
    
    ThisWorkbook.Save
    
Sheets(NewName).Activate
        
    Exit Sub


MyError:
    If Err.Number = 1004 Then
    MsgBox ("Error: There is already a gun with that name." & Chr(10) _
    & "A gun was created with the name MASTER (2)." & Chr(10) _
    & "Double click the tab and rename it.")
    End If
     
End Sub

Sub DeleteGun()
'
' DeleteGun Macro
'


'
    ActiveSheet.Select
    ActiveWindow.SelectedSheets.Delete
    
    Sheets("Collection").Activate
End Sub

Sub SortWorkbook()

Dim n As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
With Application
    .ScreenUpdating = False
End With
SortDescending = False
If ActiveWindow.SelectedSheets.Count = 1 Then
    FirstWSToSort = 6
    LastWSToSort = Worksheets.Count
Else
    With ActiveWindow.SelectedSheets
        For n = 2 To .Count
            If .Item(n - 1).Index <> .Item(n).Index - 1 Then
                MsgBox "You cannot sort non-adjacent sheets"
                Exit Sub
            End If
        Next n
        FirstWSToSort = .Item(1).Index
        LastWSToSort = .Item(.Count).Index
     End With
End If
For M = FirstWSToSort To LastWSToSort
    For n = M To LastWSToSort
        If SortDescending = True Then
            If UCase(Worksheets(n).Name) > UCase(Worksheets(M).Name) Then
                Worksheets(n).Move Before:=Worksheets(M)
            End If
        Else
            If UCase(Worksheets(n).Name) < UCase(Worksheets(M).Name) Then
               Worksheets(n).Move Before:=Worksheets(M)
            End If
        End If
     Next n
Next M
With Application
    .ScreenUpdating = True




End With


Sheets("Collection").Activate
End Sub

 

[JoeMo]

None of the code you posted is event code so I can't see anything there that would cause the error you get. As I said in post #27, I can't reproduce the error so I have no way to diagnose its cause.

 

[BVavra]

Is there a way I could attach the workbook here or send it to you?