Create List name based on Tabs within workbook

[FGaxha]

Hi Masters,
I have a macro to copy Tab's name to a unique list. How to make it dynamically when a new tab is created to show up in the index list without running Macros. either formula or vba code?


Sub CreateIndex()
'updateby Extendoffice
Dim xAlerts As Boolean
Dim I As Long
Dim xShtIndex As Worksheet
Dim xSht As Variant
xAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Index").Delete
On Error GoTo 0
Set xShtIndex = Sheets.Add(Sheets(1))
xShtIndex.Name = "Index"
I = 1
Cells(1, 1).Value = "INDEX"
For Each xSht In ThisWorkbook.Sheets
If xSht.Name <> "Index" Then
I = I + 1
xShtIndex.Hyperlinks.Add Cells(I, 1), "", "'" & xSht.Name & "'!A1", , xSht.Name
End If
Next
Application.DisplayAlerts = xAlerts
End Sub

 

[HighAndWilder]

Hi Masters,
I have a macro to copy Tab's name to a unique list. How to make it dynamically when a new tab is created to show up in the index list without running Macros. either formula or vba code?


Sub CreateIndex()
'updateby Extendoffice
Dim xAlerts As Boolean
Dim I As Long
Dim xShtIndex As Worksheet
Dim xSht As Variant
xAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Index").Delete
On Error GoTo 0
Set xShtIndex = Sheets.Add(Sheets(1))
xShtIndex.Name = "Index"
I = 1
Cells(1, 1).Value = "INDEX"
For Each xSht In ThisWorkbook.Sheets
If xSht.Name <> "Index" Then
I = I + 1
xShtIndex.Hyperlinks.Add Cells(I, 1), "", "'" & xSht.Name & "'!A1", , xSht.Name
End If
Next
Application.DisplayAlerts = xAlerts
End Sub

Why not just run the code when the Index sheet is activated?

You can clear the sheets contents and then write the current sheets names to the sheet.

There is not a sheet name change event that you can use.

 

[John_w]

Why not just run the code when the Index sheet is activated?

You can clear the sheets contents and then write the current sheets names to the sheet.

That's the approach I would take.

Module1 code:

Sub CreateIndex()
    'updateby Extendoffice
    Dim xAlerts As Boolean
    Dim I As Long
    Dim xShtIndex As Worksheet
    Dim xSht As Variant
    Application.EnableEvents = False
    xAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Index").Delete
    On Error GoTo 0
    Set xShtIndex = Sheets.Add(Sheets(1))
    xShtIndex.Name = "Index"
    I = 1
    Cells(1, 1).Value = "INDEX"
    For Each xSht In ThisWorkbook.Sheets
        If xSht.Name <> "Index" Then
            I = I + 1
            xShtIndex.Hyperlinks.Add Cells(I, 1), "", "'" & xSht.Name & "'!A1", , xSht.Name
        End If
    Next
    Application.DisplayAlerts = xAlerts
    Application.EnableEvents = True
End Sub

ThisWorkbook module code:

Private Sub Workbook_Open()
    CreateIndex
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = "Index" Then CreateIndex
End Sub

Save, close and reopen the workbook.

 

[hungtbatman1]

Do these steps in order:
1. Delete the "Index" sheet
2. code in the ThisWorkbook module

Option Explicit

Private Sub Workbook_NewSheet(ByVal sh As Object)
    If Not disallow Then CreateDeleteIndex sh.Name, False
End Sub

Private Sub Workbook_Open()
    disallow = True
    CreateDeleteIndex ""
    disallow = False
End Sub

Private Sub Workbook_SheetBeforeDelete(ByVal sh As Object)
    CreateDeleteIndex sh.Name, True
End Sub

3. code in Module1

Option Explicit

Public disallow As Boolean

Sub CreateDeleteIndex(Optional ByVal shName As String = "", Optional ByVal bDelete As Boolean = False)
'updateby Extendoffice
Dim xAlerts As Boolean
Dim i As Long, b As Long
Dim xShtIndex As Worksheet
Dim xSht As Variant, cell_ As Range
    xAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False
    On Error Resume Next
    Set xShtIndex = Worksheets("Index")
    b = Err.Number
    On Error GoTo 0
    Application.DisplayAlerts = xAlerts
    If b Then
'        no sheet. Create new
        Set xShtIndex = Worksheets.Add(Worksheets(1))
        With xShtIndex
            .Name = "Index"
            i = 1
            .Range("A1").Value = "INDEX"
            For Each xSht In ThisWorkbook.Sheets
                If xSht.Name <> "Index" Then
                    i = i + 1
                    .Hyperlinks.Add .Cells(i, 1), "", "'" & xSht.Name & "'!A1", , xSht.Name
                End If
            Next
        End With
    Else
        If shName = "" Then Exit Sub
        With xShtIndex
            If bDelete Then
    '            The sheet has been deleted
                Set cell_ = .Range("A2:A1000").Find(shName, , xlValues, xlWhole, xlByColumns, xlNext)
                If Not cell_ Is Nothing Then cell_.EntireRow.Delete
            Else
    '            The sheet has been added
                .Hyperlinks.Add .Range("A" & Rows.Count).End(xlUp).Offset(1), "", "'" & shName & "'!A1", , shName
            End If
        End With
    End If
End Sub

4. Save the file as XLSM and close.

5. Open for the first time and save.

 

[FGaxha]

thank you both
It worked great