Adjusting a sheet sorting macro to sort every sheet except for one

%3CLINGO-SUB%20id%3D%22lingo-sub-1591181%22%20slang%3D%22en-US%22%3EAdjusting%20a%20sheet%20sorting%20macro%20to%20sort%20every%20sheet%20except%20for%20one%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1591181%22%20slang%3D%22en-US%22%3E%3CP%3EHi%20Community!%3C%2FP%3E%3CP%3EI'm%20in%20the%20final%20phase%20of%20uni%20assignment%20requiring%20us%20to%20build%20some%20macros%2C%20and%20I've%20decided%20on%20a%20macro%20that%20creates%20a%20table%20of%20contents%2C%20and%20one%20that%20sorts%20all%20sheets%20alphabetically.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EIs%20it%20possible%20to%20exclude%20the%20table%20of%20contents%20from%20the%20sort%20function%2C%20and%20to%20have%20the%20sort%20function%20return%20the%20user%20to%20the%20table%20of%20contents%2C%20instead%20of%20the%20first%20sheet%20matching%20the%20sort%20criteria%3F%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI've%20attached%20the%20spreadsheet%20and%20the%20scripts%20below%3A%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ETIA%2C%3C%2FP%3E%3CP%3EPaul%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThe%20ToC%20script%3A%3C%2FP%3E%3CP%3ESub%20TableOfContents()%3CBR%20%2F%3E'PURPOSE%3A%20Add%20a%20Table%20of%20Contents%20worksheets%20to%20easily%20navigate%20to%20any%20tab%3CBR%20%2F%3E'SOURCE%3A%20%3CA%20href%3D%22http%3A%2F%2Fwww.TheSpreadsheetGuru.com%22%20target%3D%22_blank%22%20rel%3D%22noopener%20nofollow%20noreferrer%22%3Ewww.TheSpreadsheetGuru.com%3C%2FA%3E%3CBR%20%2F%3EDim%20sht%20As%20Worksheet%3CBR%20%2F%3EDim%20Content_sht%20As%20Worksheet%3CBR%20%2F%3EDim%20myArray%20As%20Variant%3CBR%20%2F%3EDim%20x%20As%20Long%2C%20y%20As%20Long%3CBR%20%2F%3EDim%20shtName1%20As%20String%2C%20shtName2%20As%20String%3CBR%20%2F%3EDim%20ContentName%20As%20String%3C%2FP%3E%3CP%3E'Inputs%3CBR%20%2F%3EContentName%20%3D%20%22Table%20of%20Contents%22%3C%2FP%3E%3CP%3E'Optimize%20Code%3CBR%20%2F%3EApplication.DisplayAlerts%20%3D%20False%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20False%3C%2FP%3E%3CP%3E'Delete%20Contents%20Sheet%20if%20it%20already%20exists%3CBR%20%2F%3EOn%20Error%20Resume%20Next%3CBR%20%2F%3EWorksheets(%22Table%20of%20Contents%22).Activate%3CBR%20%2F%3EOn%20Error%20GoTo%200%3C%2FP%3E%3CP%3EIf%20ActiveSheet.Name%20%3D%20ContentName%20Then%3CBR%20%2F%3EmyAnswer%20%3D%20MsgBox(%22A%20worksheet%20named%20%5B%22%20%26amp%3B%20ContentName%20%26amp%3B%20_%3CBR%20%2F%3E%22%5D%20has%20already%20been%20created%2C%20would%20you%20like%20to%20replace%20it%3F%22%2C%20vbYesNo)%3CBR%20%2F%3E%3CBR%20%2F%3E'Did%20user%20select%20No%20or%20Cancel%3F%3CBR%20%2F%3EIf%20myAnswer%20%26lt%3B%26gt%3B%20vbYes%20Then%20GoTo%20ExitSub%3CBR%20%2F%3E%3CBR%20%2F%3E'Delete%20old%20Contents%20Tab%3CBR%20%2F%3EWorksheets(ContentName).Delete%3CBR%20%2F%3EEnd%20If%3C%2FP%3E%3CP%3E'Create%20New%20Contents%20Sheet%3CBR%20%2F%3EWorksheets.Add%20Before%3A%3DWorksheets(1)%3C%2FP%3E%3CP%3E'Set%20variable%20to%20Contents%20Sheet%3CBR%20%2F%3ESet%20Content_sht%20%3D%20ActiveSheet%3C%2FP%3E%3CP%3E'Format%20Contents%20Sheet%3CBR%20%2F%3EWith%20Content_sht%3CBR%20%2F%3E.Name%20%3D%20ContentName%3CBR%20%2F%3E.Range(%22B1%22)%20%3D%20%22Table%20of%20Contents%22%3CBR%20%2F%3E.Range(%22B1%22).Font.Bold%20%3D%20True%3CBR%20%2F%3EEnd%20With%3C%2FP%3E%3CP%3E'Create%20Array%20list%20with%20sheet%20names%20(excluding%20Contents)%3CBR%20%2F%3EReDim%20myArray(1%20To%20Worksheets.Count%20-%201)%3C%2FP%3E%3CP%3EFor%20Each%20sht%20In%20ActiveWorkbook.Worksheets%3CBR%20%2F%3EIf%20sht.Name%20%26lt%3B%26gt%3B%20ContentName%20Then%3CBR%20%2F%3EmyArray(x%20%2B%201)%20%3D%20sht.Name%3CBR%20%2F%3Ex%20%3D%20x%20%2B%201%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3ENext%20sht%3CBR%20%2F%3E%3CBR%20%2F%3E'Alphabetize%20Sheet%20Names%20in%20Array%20List%3CBR%20%2F%3EFor%20x%20%3D%20LBound(myArray)%20To%20UBound(myArray)%3CBR%20%2F%3EFor%20y%20%3D%20x%20To%20UBound(myArray)%3CBR%20%2F%3EIf%20UCase(myArray(y))%20%26lt%3B%20UCase(myArray(x))%20Then%3CBR%20%2F%3EshtName1%20%3D%20myArray(x)%3CBR%20%2F%3EshtName2%20%3D%20myArray(y)%3CBR%20%2F%3EmyArray(x)%20%3D%20shtName2%3CBR%20%2F%3EmyArray(y)%20%3D%20shtName1%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3ENext%20y%3CBR%20%2F%3ENext%20x%3C%2FP%3E%3CP%3E'Create%20Table%20of%20Contents%3CBR%20%2F%3EFor%20x%20%3D%20LBound(myArray)%20To%20UBound(myArray)%3CBR%20%2F%3ESet%20sht%20%3D%20Worksheets(myArray(x))%3CBR%20%2F%3Esht.Activate%3CBR%20%2F%3EWith%20Content_sht%3CBR%20%2F%3E.Hyperlinks.Add%20.Cells(x%20%2B%202%2C%203)%2C%20%22%22%2C%20_%3CBR%20%2F%3ESubAddress%3A%3D%22'%22%20%26amp%3B%20sht.Name%20%26amp%3B%20%22'!A1%22%2C%20_%3CBR%20%2F%3ETextToDisplay%3A%3Dsht.Name%3CBR%20%2F%3E.Cells(x%20%2B%202%2C%202).Value%20%3D%20x%3CBR%20%2F%3EEnd%20With%3CBR%20%2F%3ENext%20x%3CBR%20%2F%3E%3CBR%20%2F%3EContent_sht.Activate%3CBR%20%2F%3EContent_sht.Columns(3).EntireColumn.AutoFit%3C%2FP%3E%3CP%3E'Format%20columns%3CBR%20%2F%3EColumns(%22A%3AB%22).ColumnWidth%20%3D%203.86%3CBR%20%2F%3ERange(%22B1%22).Font.Size%20%3D%2018%3CBR%20%2F%3ERange(%22B1%3AF1%22).Borders(xlEdgeBottom).Weight%20%3D%20xlThin%3CBR%20%2F%3E%3CBR%20%2F%3EWith%20Range(%22B3%3AB%22%20%26amp%3B%20x%20%2B%201)%3CBR%20%2F%3E.Borders(xlInsideHorizontal).Color%20%3D%20RGB(255%2C%20255%2C%20255)%3CBR%20%2F%3E.Borders(xlInsideHorizontal).Weight%20%3D%20xlMedium%3CBR%20%2F%3E.HorizontalAlignment%20%3D%20xlCenter%3CBR%20%2F%3E.VerticalAlignment%20%3D%20xlCenter%3CBR%20%2F%3E.Font.Color%20%3D%20RGB(255%2C%20255%2C%20255)%3CBR%20%2F%3E.Interior.Color%20%3D%20RGB(91%2C%20155%2C%20213)%3CBR%20%2F%3EEnd%20With%3C%2FP%3E%3CP%3E'Adjust%20Zoom%20and%20Remove%20Gridlines%3CBR%20%2F%3EActiveWindow.DisplayGridlines%20%3D%20False%3CBR%20%2F%3EActiveWindow.Zoom%20%3D%20130%3C%2FP%3E%3CP%3EExitSub%3A%3CBR%20%2F%3E'Optimize%20Code%3CBR%20%2F%3EApplication.DisplayAlerts%20%3D%20True%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20True%3C%2FP%3E%3CP%3E%3CBR%20%2F%3EThe%20Sort%20script%3A%3C%2FP%3E%3CP%3ESub%20AlphebetizeTabs()%3CBR%20%2F%3E'Order%20sheets%20in%20alphabetical%20order%2C%20A%20to%20Z%20or%20Z%20to%20A%3CBR%20%2F%3E'Sourced%20from%20%3CA%20href%3D%22https%3A%2F%2Fwww.ablebits.com%2Foffice-addins-blog%2F2018%2F05%2F02%2Falphabetize-tabs-excel%2F%22%20target%3D%22_blank%22%20rel%3D%22noopener%20nofollow%20noreferrer%22%3Ehttps%3A%2F%2Fwww.ablebits.com%2Foffice-addins-blog%2F2018%2F05%2F02%2Falphabetize-tabs-excel%2F%3C%2FA%3E%3CBR%20%2F%3EDim%20SortOrder%20As%20Integer%3CBR%20%2F%3E%3CBR%20%2F%3ESortOrder%20%3D%20showUserForm%3CBR%20%2F%3E%3CBR%20%2F%3EIf%20SortOrder%20%3D%200%20Then%20Exit%20Sub%3CBR%20%2F%3E%3CBR%20%2F%3EFor%20x%20%3D%201%20To%20Application.Sheets.Count%3CBR%20%2F%3EFor%20y%20%3D%201%20To%20Application.Sheets.Count%20-%201%3CBR%20%2F%3EIf%20SortOrder%20%3D%201%20Then%3CBR%20%2F%3EIf%20UCase%24(Application.Sheets(y).Name)%20%26gt%3B%20UCase%24(Application.Sheets(y%20%2B%201).Name)%20Then%3CBR%20%2F%3ESheets(y).Move%20after%3A%3DSheets(y%20%2B%201)%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3EElseIf%20SortOrder%20%3D%202%20Then%3CBR%20%2F%3EIf%20UCase%24(Application.Sheets(y).Name)%20%26lt%3B%20UCase%24(Application.Sheets(y%20%2B%201).Name)%20Then%3CBR%20%2F%3ESheets(y).Move%20after%3A%3DSheets(y%20%2B%201)%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3ENext%3CBR%20%2F%3ENext%3CBR%20%2F%3EEnd%20Sub%3CBR%20%2F%3E%3CBR%20%2F%3EFunction%20showUserForm()%20As%20Integer%3CBR%20%2F%3EshowUserForm%20%3D%200%3CBR%20%2F%3E%3CBR%20%2F%3ELoad%20SortOrderForm%3CBR%20%2F%3ESortOrderForm.Show%20(1)%3CBR%20%2F%3EshowUserForm%20%3D%20SortOrderForm.Tag%3CBR%20%2F%3E%3CBR%20%2F%3EUnload%20SortOrderForm%3CBR%20%2F%3EEnd%20Function%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1591181%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1593380%22%20slang%3D%22en-US%22%3ERe%3A%20Adjusting%20a%20sheet%20sorting%20macro%20to%20sort%20every%20sheet%20except%20for%20one%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1593380%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F750280%22%20target%3D%22_blank%22%3E%40PaulOlsen%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EHi%20Paul%2C%3C%2FP%3E%3CP%3EThis%20is%20off%20the%20top%20of%20my%20head%20without%20getting%20into%20the%20VBA%20too%20much.%3C%2FP%3E%3CP%3EInstead%20of%20trying%20to%20exclude%20the%20table%20of%20contents%2C%20can%20you%20let%20it%20sort%20it%2C%20then%20add%20a%20script%20that%20will%20move%20it%20to%20the%20position%20desired%3F%3C%2FP%3E%3CP%3E%3CSPAN%3EWorksheets(%3C%2FSPAN%3E%3CSPAN%20class%3D%22hljs-string%22%3E%22TOC%22%3C%2FSPAN%3E%3CSPAN%3E).Move%20_%20before%3A%3DWorksheets(%3C%2FSPAN%3E%3CSPAN%20class%3D%22hljs-string%22%3E%22Sheet1%22%3C%2FSPAN%3E%3CSPAN%3E)%26nbsp%3B%20-%20or%20use%20%22after%22%20in%20place%20of%20%22before%22%3C%2FSPAN%3E%3C%2FP%3E%3CP%3EThen%20add%20more%20code%20to%20select%20that%20sheet%20(and%20a%20cell%20within%20it%3F).%3C%2FP%3E%3CP%3Esheets(%22TOC%22).select%3C%2FP%3E%3CP%3E'Range(%22A1%22).Select%20%3CIF%20desired%3D%22%22%3E%3C%2FIF%3E%3C%2FP%3E%3CP%3EIf%20the%20sorting%20causes%20the%20first%20page%20to%20get%20moved%20around%2C%20then%20create%20a%20false%20front%20page%20that%20will%20always%20appear%20first%20and%20keep%20it%20hidden%20to%20use%20as%20an%20%22achor%22.%3C%2FP%3E%3C%2FLINGO-BODY%3E
New Contributor

Hi Community!

I'm in the final phase of uni assignment requiring us to build some macros, and I've decided on a macro that creates a table of contents, and one that sorts all sheets alphabetically.

 

Is it possible to exclude the table of contents from the sort function, and to have the sort function return the user to the table of contents, instead of the first sheet matching the sort criteria?

 

I've attached the spreadsheet and the scripts below:

 

TIA,

Paul

 

The ToC script:

Sub TableOfContents()
'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String

'Inputs
ContentName = "Table of Contents"

'Optimize Code
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Delete Contents Sheet if it already exists
On Error Resume Next
Worksheets("Table of Contents").Activate
On Error GoTo 0

If ActiveSheet.Name = ContentName Then
myAnswer = MsgBox("A worksheet named [" & ContentName & _
"] has already been created, would you like to replace it?", vbYesNo)

'Did user select No or Cancel?
If myAnswer <> vbYes Then GoTo ExitSub

'Delete old Contents Tab
Worksheets(ContentName).Delete
End If

'Create New Contents Sheet
Worksheets.Add Before:=Worksheets(1)

'Set variable to Contents Sheet
Set Content_sht = ActiveSheet

'Format Contents Sheet
With Content_sht
.Name = ContentName
.Range("B1") = "Table of Contents"
.Range("B1").Font.Bold = True
End With

'Create Array list with sheet names (excluding Contents)
ReDim myArray(1 To Worksheets.Count - 1)

For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> ContentName Then
myArray(x + 1) = sht.Name
x = x + 1
End If
Next sht

'Alphabetize Sheet Names in Array List
For x = LBound(myArray) To UBound(myArray)
For y = x To UBound(myArray)
If UCase(myArray(y)) < UCase(myArray(x)) Then
shtName1 = myArray(x)
shtName2 = myArray(y)
myArray(x) = shtName2
myArray(y) = shtName1
End If
Next y
Next x

'Create Table of Contents
For x = LBound(myArray) To UBound(myArray)
Set sht = Worksheets(myArray(x))
sht.Activate
With Content_sht
.Hyperlinks.Add .Cells(x + 2, 3), "", _
SubAddress:="'" & sht.Name & "'!A1", _
TextToDisplay:=sht.Name
.Cells(x + 2, 2).Value = x
End With
Next x

Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit

'Format columns
Columns("A:B").ColumnWidth = 3.86
Range("B1").Font.Size = 18
Range("B1:F1").Borders(xlEdgeBottom).Weight = xlThin

With Range("B3:B" & x + 1)
.Borders(xlInsideHorizontal).Color = RGB(255, 255, 255)
.Borders(xlInsideHorizontal).Weight = xlMedium
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Color = RGB(255, 255, 255)
.Interior.Color = RGB(91, 155, 213)
End With

'Adjust Zoom and Remove Gridlines
ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 130

ExitSub:
'Optimize Code
Application.DisplayAlerts = True
Application.ScreenUpdating = True


The Sort script:

Sub AlphebetizeTabs()
'Order sheets in alphabetical order, A to Z or Z to A
'Sourced from https://www.ablebits.com/office-addins-blog/2018/05/02/alphabetize-tabs-excel/
Dim SortOrder As Integer

SortOrder = showUserForm

If SortOrder = 0 Then Exit Sub

For x = 1 To Application.Sheets.Count
For y = 1 To Application.Sheets.Count - 1
If SortOrder = 1 Then
If UCase$(Application.Sheets(y).Name) > UCase$(Application.Sheets(y + 1).Name) Then
Sheets(y).Move after:=Sheets(y + 1)
End If
ElseIf SortOrder = 2 Then
If UCase$(Application.Sheets(y).Name) < UCase$(Application.Sheets(y + 1).Name) Then
Sheets(y).Move after:=Sheets(y + 1)
End If
End If
Next
Next
End Sub

Function showUserForm() As Integer
showUserForm = 0

Load SortOrderForm
SortOrderForm.Show (1)
showUserForm = SortOrderForm.Tag

Unload SortOrderForm
End Function

 

1 Reply

@PaulOlsen 

Hi Paul,

This is off the top of my head without getting into the VBA too much.

Instead of trying to exclude the table of contents, can you let it sort it, then add a script that will move it to the position desired?

Worksheets("TOC").Move _ before:=Worksheets("Sheet1")  - or use "after" in place of "before"

Then add more code to select that sheet (and a cell within it?).

sheets("TOC").select

'Range("A1").Select <if desired, remove the ' >

If the sorting causes the first page to get moved around, then create a false front page that will always appear first and keep it hidden to use as an "achor".