B
Ben Dummar
I am trying to create a TOC with links in the first sheet with the sheets
from 4 on being alphabetized. The TOC with links is working but not the
alphabetizing fo tabs.
What am I missing?
Ben
Code used below------
Private Sub Worksheet_Activate()
Dim anySheet As Worksheet
Dim myCounter As Long
Cells.Clear ' remove previous content
myCounter = 0
For Each anySheet In Worksheets
If anySheet.Name <> ActiveSheet.Name Then
Range("B2").Offset(myCounter, 0) = anySheet.Name
'this adds hyperlink remove if you don't want it
ActiveSheet.Hyperlinks.Add anchor:=Range("B2").Offset(myCounter, 0), _
Address:="", SubAddress:="'" & anySheet.Name & "'!A1"
'update the offset counter, keep this
myCounter = myCounter + 1
End If
Next
End Sub
Sub SortWorksheets()
Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
SortDescending = False
If ActiveWindow.SelectedSheets.Count = 1 Then
FirstWSToSort = 4
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
End Sub
from 4 on being alphabetized. The TOC with links is working but not the
alphabetizing fo tabs.
What am I missing?
Ben
Code used below------
Private Sub Worksheet_Activate()
Dim anySheet As Worksheet
Dim myCounter As Long
Cells.Clear ' remove previous content
myCounter = 0
For Each anySheet In Worksheets
If anySheet.Name <> ActiveSheet.Name Then
Range("B2").Offset(myCounter, 0) = anySheet.Name
'this adds hyperlink remove if you don't want it
ActiveSheet.Hyperlinks.Add anchor:=Range("B2").Offset(myCounter, 0), _
Address:="", SubAddress:="'" & anySheet.Name & "'!A1"
'update the offset counter, keep this
myCounter = myCounter + 1
End If
Next
End Sub
Sub SortWorksheets()
Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
SortDescending = False
If ActiveWindow.SelectedSheets.Count = 1 Then
FirstWSToSort = 4
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
End Sub