Public Sub IndexSheetNames()

'       This subroutine requires two user functions:
'               WorksheetExtant
'               IsSheetNameValid
 
'       The subroutine will build an index sheet of all the sheetnames in the workbook

Dim xWs As Worksheet
On Error Resume Next

Application.DisplayAlerts = False

' First sort the sheets (if the user requires it)

Dim SortAnswer As Integer
SortAnswer = MsgBox("Do you want to sort the sheets first?", vbYesNo + vbQuestion, "Sort?")
If SortAnswer = vbYes Then
    Dim sCount, i, j As Integer
    sCount = Worksheets.Count
    If sCount = 1 Then Exit Sub
    For i = 1 To sCount - 1
        For j = i + 1 To sCount
            If Worksheets(j).Name < Worksheets(i).Name Then
                Worksheets(j).Move before:=Worksheets(i)
            End If
        Next j
    Next i
End If

Dim OurName As String
Dim Default As String
Dim GoodName As Boolean
Dim LastCol  As Integer
Dim LastRow As Integer
AskName:
GoodName = False
Default = "$$$INDEX"    ' <==== Change to your own default name
OurName = Default

' Comment out the code between the markers if you want to use only your default
' *****************************************************************************

Do Until GoodName = True
    OurName = InputBox("Name of Index sheet?" & vbCrLf _
        & vbCrLf & "(Null entry or Cancel will terminate)", "Enter Name For Index", Default:=Default)
    If OurName = "" Or OurName = vbNullString Then Exit Sub
    If Not IsSheetNameValid(OurName) Then
        Default = OurName
        MsgBox "Invalid sheet name" & vbCrLf & vbCrLf & "Please re-enter", vbCritical
    Else
        GoodName = True
    End If
Loop
' *****************************************************************************

XtitleId = OurName
If WorksheetExtant(XtitleId) Then
    SortAnswer = MsgBox("Do you want to overwrite the existing index?", vbYesNo + vbQuestion, "Overwrite?")
    If SortAnswer = vbNo Then
        If GoodName = False Then Exit Sub
        GoTo AskName
    End If
    Application.Sheets(XtitleId).Delete ' delete any existing sheet of our name
End If

Application.Sheets.Add Application.Sheets(1)

Set xWs = Application.ActiveSheet

xWs.Name = XtitleId
xWs.Range("A1") = "Sheet Name"

' Add any other columns you may need in the index in here

xWs.Range("B1") = "Checked"                             ' *  These are the column headers.
xWs.Range("C1") = "Correct"                             ' *  Change these to match your own requirements
xWs.Range("D1") = "Comments                       "     ' *

LastCol = xWs.UsedRange.Columns(xWs.UsedRange.Columns.Count).Column

' Center headings, add borders and color the headings

xWs.Range("A1:D1").HorizontalAlignment = xlCenter
xWs.Range("A1:D1").Borders.LineStyle = xlContinuous
xWs.Range("A1:D1").Interior.ColorIndex = 15

X = Application.Sheets.Count
LastRow = Application.Sheets.Count + 1    '   Add one for the headers
For i = 1 To X
    xWs.Range("A" & (i + 1)) = xWs.Application.Sheets(i).Name
Next i

xWs.Range(Cells(1, 1), Cells(LastRow, LastCol)).Borders.LineStyle = xlContinuous
ActiveSheet.PageSetup.CenterHeader = "&C&24&U&B Index of Workbook " & ThisWorkbook.Name
ActiveSheet.PageSetup.RightFooter = Format(Now, "MMMM DD, YYYY HH:MM:SS")
ActiveSheet.PageSetup.CenterFooter = "Page &P of &N"
ActiveSheet.PageSetup.CenterHorizontally = True
Application.DisplayAlerts = True
xWs.Range(Cells(1, 1), Cells(LastRow, LastCol)).EntireColumn.AutoFit
Range("A1").Select
Application.CutCopyMode = False
End Sub