Create auto sort pages, create a TOC/Index, and add hyperlinks back to the TOC

Question

I have several macros in Excel 2010 and I would like each macro to proceed something like this:

Upon clicking the + or "Create New Worksheet" I'd like a prompt for the sheet name that is to be created... [Proceed to #Sort_Active_Book]

Sort_Active_Book
Run a macro named "Sort_Active_Book" to alphanumerically sort the tabs leaving the TOC as the first tab (on the left)... [Proceed to #Rebuild_TOC]

Rebuild_TOC
Rebuild the TOC/Index using another macro named "Rebuild_TOC/Index. Rebuilding the TOC will delete the page and then create a new page at the beginning and name it "TOC"

It would be best to have these separate so I can use each macro separately for expand-ability/versatility later. With this workbook being used every day, I'll need the ability to call some of these macros.

The code I already have for Rebuild_TOC is:

Sub Rebuild_TOC()
Dim wbBook As Workbook
Dim wsActive As Worksheet
Dim wsSheet As Worksheet
Dim lnRow As Long
Dim lnPages As Long
Dim lnCount As Long
Set wbBook = ActiveWorkbook

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .EnableEvents = False
End With
'' Calls sub to organize the tabs in alphabetical order while keeping "TOC" as the FIRST tab.'
Application.Run("Sort_Active_Book")
'' Removed calling the Create_Back_Links line because I think It's possible to integrate into the existing code with it
'' already iterating through the worksheets.
' Application.Run("Create_Back_Links")

'' If the TOC sheet already exists, delete it and add a new
'' worksheet as the first in the document.
On Error Resume Next
With wbBook
    .Worksheets("TOC").Delete
    .Worksheets.Add Before:=.Worksheets(1)
End With
On Error GoTo 0
Set wsActive = wbBook.ActiveSheet
With wsActive
    .Name = "TOC"
    With .Range("A1:B1")
        .Value = VBA.Array("Table of Contents", "Sheet #")
        .Font.Bold = True
    End With
End With
lnRow = 2
lnCount = 1
'' Iterate through the worksheets in the workbook and create
'' sheetnames, add hyperlink and count & write the running number
'' of pages to be printed for each sheet on the TOC sheet.
For Each wsSheet In wbBook.Worksheets
    If wsSheet.Name <> wsActive.Name Then
        wsSheet.Activate
        With wsActive
            .Hyperlinks.Add .Cells(lnRow, 1), "", SubAddress:="'" & wsSheet.Name & "'!A1", TextToDisplay:=wsSheet.Name
            .Cells(lnRow, 2).Value = "'" & lnCount
        End With
        .Range("A1").Select
        .Range("A1").ClearContents
         '' Instead of placing text in cell A1 I've decided to use the hyperlink's TextToDisplay instead.
         ' .Range("A1").Value = "Back to TOC"
        .ActiveCell.Hyperlinks.Add Anchor:=("A1"), Address:="", SubAddress:="", TextToDisplay: = "Back to TOC"
        lnRow = lnRow + 1
        lnCount = lnCount + 1
    End If
Next wsSheet
wsActive.Activate
wsActive.Columns("A:B").EntireColumn.AutoFit
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

The code I already have for Sort_Active_Book is (and I already know works):

Sub Sort_Active_Book()
Dim TotalSheets As Integer
Dim p As Integer
Dim iAnswer As VbMsgBoxResult

'
' Move the TOC to the begining of the document.
'
  Sheets("TOC").Move Before:=Sheets(1)
'
' Prompt the user as to which direction they wish to
' sort the worksheets.
'
   iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) & "Clicking No will sort in Descending Order", vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
   For TotalSheets = 1 To Sheets.Count
      For p = 2 To Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
         If iAnswer = vbYes Then
            If UCase$(Sheets(p).Name) = "TOC" Then
               Sheets(p).Move Before:=Sheets(1)
            ElseIf UCase$(Sheets(p).Name) > UCase$(Sheets(p + 1).Name) Then
               Sheets(p).Move After:=Sheets(p + 1)
            End If
'
' If the answer is No, then sort in descending order.
'
         ElseIf iAnswer = vbNo Then
            If UCase$(Sheets(p).Name) = "TOC" Then
                Sheets(p).Move Before:=Sheets(1)
            ElseIf UCase$(Sheets(p).Name) < UCase$(Sheets(p + 1).Name) Then
               Sheets(p).Move After:=Sheets(p + 1)
            End If
         End If
      Next p
   Next TotalSheets
End Sub

I would prefer that Sort_Active_Book only asks if for ascending/descending only if it is run manually (may need to create a different macro or split the current code into another macro(s).

I am stuck as to which direction I should take it to accomplish my goal.

Answer 1

You will need to use the ThisWorkbook code module, which can be found here:

Double click on that code module to bring up its module sheet. The in the top, use the drop downs to select Workbook (left-hand drop down) and then NewSheet (right-hand drop down) as shown in the image.

Then you should be able to use this code to do what you're looking for:

Private Sub Workbook_NewSheet(ByVal Sh As Object)

    Dim sName As String
    Dim bValidName As Boolean
    Dim i As Long

    bValidName = False

    Do While bValidName = False
        sName = InputBox("Please name this new worksheet:", "New Sheet Name", Sh.Name)
            If Len(sName) > 0 Then
            For i = 1 To 7
                sName = Replace(sName, Mid(":\/?*[]", i, 1), " ")
            Next i
            sName = Trim(Left(WorksheetFunction.Trim(sName), 31))
            If Not Evaluate("ISREF('" & sName & "'!A1)") Then bValidName = True
        End If
    Loop

    Sh.Name = sName

    Call Sort_Active_Book
    Call Rebuild_TOC

End Sub