The list of sheets names is alphabetically sorted and is always accurate, even if you rename, add, or delete sheets.
In the procedures below, you will notice several references to ShtNdx. This is the CodeName I gave to Tab "Sheet Index." This allows you to change the Tab Name as you prefer. If you just copy the code below into a sheet, you must change the CodeName of that Tab. In the Code samples, you will also note that ShtNdex is not used like Tab names are. Tab names must be referenced in VBA like:
- Code: Select all
With Sheets("TabName")
Do Something
CodeNames must never be referenced that way. Always use the bare CodeName:
- Code: Select all
With CodeName
Do something
When using the Sheets Collection, Sheets with custom CodeNames have lower index numbers than sheets with standard CodeNames like "SheetN" where N is a number.
BTW, Workbooks have CodeNames, too; But that is a tale for another time.
Be sure and view the Read Me Sheet for details and instructions
This Code has been tested in Excel 2002, and 2007 on Windows XP.
For Code Geeks, the Code is in the four code samples following.
- Code: Select all
Option Explicit
Private Sub Worksheet_Activate()
'An interactive index that refreshes each time it's viewed
'so that it is always current.
'
'The Selection Change Sub below keeps this sheet next to
'the Sheet chosen when the User clicks on a Sheet name
'in the Sheet Index List.
'ShtNdx is the CodeName of "Sheet Index"
Const TopRowOfList As Long = 4 'Set As Desired
Dim i As Long 'Common index variable
Dim r As Long 'Row Counter for Index List
r = TopRowOfList 'Set here because it's used to clear the list
Application.ScreenUpdating = False
''''Clear the existing list
If LastRow >= TopRowOfList Then ShtNdx.Range("A" & CStr(TopRowOfList) & _
":A" & CStr(LastRow)).ClearContents
''''Create the List of Sheet Names
With ThisWorkbook
For i = 1 To .Sheets.Count
If .Sheets(i) Is ShtNdx Then
'Don't list This sheet
'Don't increment Row counter
GoTo NextLoop
Else
ShtNdx.Cells(r, 1) = .Sheets(i).Name
r = r + 1 'Increment Row Counter
End If
NextLoop:
Next i
End With
''''Sort the list alphabetically
Range("A4:A" & CStr(LastRow)).Sort _
Key1:=Range("A1"), _
Header:=xlNo
Application.ScreenUpdating = True
End Sub
- Code: Select all
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
''''Check criteria for running this sub
'Is only one Cell selected
If Target.Count <> 1 Then Exit Sub
'Is there a List
If LastRow < 4 Then Exit Sub
'Is the selection in the List
If Intersect(Target, Range("A4:A" & CStr(LastRow))) Is Nothing Then Exit Sub
''''Move the Index Sheet, Activate the chosen Sheet, and Select "A1" _
on the chosen Sheet.
ShtNdx.Move Before:=Sheets(Target.Value)
Sheets(Target.Value).Activate
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub
- Code: Select all
Private Function LastRow() As Long
'Custom for this module.
'Always looks for the last non-empty cell in Column "A."
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
End Function
- Code: Select all
Private Sub Workbook_SheetActivate(ByVal Sht As Object)
'Moves the Sheet Index when any other tab is clicked.
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
ShtNdx.Move Before:=Sht
Sht.Activate
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub