Macro to sort excel sheets by name according to a custom order list

[Antonino2023]

Hello Community, 

I am looking to write a simple macro that will look at all the sheet names in my workbook and then rearrange them according to a custom order. For Example:

-  The workbook has 5 sheets. The sheet names are "A-Sheet", "B-Sheet", "C-Sheet", "D-Sheet", and "F-Sheet".

- Suppose the custom order list is "D-Sheet, B-Sheet, F-Sheet, A-Sheet, C-Sheet".

I would like the Macro to look at a given list and sort the sheets in the workbook according to that list. Can someone help me with the code for a macro that can do this? I have hundreds of sheets in a workbook that need to be rearranged according to a custom order list.

I found a helpful resource (see link below) that can get sort them from A to Z or Z to A, but have not yet found one for a custom order. The code for that is include below. Is there a way to modify it to achieve my requested result?

Sub TabsAscending()

  For i = 1 To Application.Sheets.Count
    For j = 1 To Application.Sheets.Count - 1
      If UCase$(Application.Sheets(j).Name) > UCase$(Application.Sheets(j + 1).Name) Then
        Sheets(j).Move after:=Sheets(j + 1)
      End If
    Next
  Next
  MsgBox "The tabs have been sorted from A to Z."

End Sub

https://www.ablebits.com/office-addins-blog/alphabetize-tabs-excel/

Thank you in advance!

[#2]

Sub RearrangeSheets()
    Dim ws As Worksheet
    Dim orderList() As Variant
    Dim i As Long
    
    ' Define the custom order list
    orderList = Array("D-Sheet", "B-Sheet", "F-Sheet", "A-Sheet", "C-Sheet")
    
    ' Disable screen updating to improve performance
    Application.ScreenUpdating = False
    
    ' Loop through each sheet name in the custom order list
    For i = LBound(orderList) To UBound(orderList)
        ' Find the sheet with the corresponding name
       ' On Error Resume Next
        Set ws = Worksheets(orderList(i))
        On Error GoTo 0
        
        ' Move the sheet to the desired position
        If Not ws Is Nothing Then
            ws.Move Before:=Worksheets(1)
        End If
    Next i
    
    ' Enable screen updating again
    Application.ScreenUpdating = True
End Sub

@Antonino2023 

[#3]

@peiyezhu 

It almost works! However it is ordering them in the opposite order. Instead of D, B, F, A, C, it is leaving them as C, A, F, B, D. Is there a simple fix for this to your existing code?

[#4]

@peiyezhu
Also, how would I specify "orderList" to create the array from a range instead? My orderlist is over 100 so I cannot paste it into the module. For example, I would want it to use the orderlist given by the cells in the current region of A1. Range("A1").CurrentRegion

[#5 · Accepted solution]

Sub RearrangeSheets()
    Dim ws As Worksheet
    Dim orderList() As Variant
    Dim cell As Range
    Dim i As Long
    
    ' Define the custom order list from range A1's current region
    orderList = Range("A1").CurrentRegion.Value
    
    ' Disable screen updating to improve performance
    Application.ScreenUpdating = False
    
    ' Loop through each cell value in the custom order list (backwards)
    For i = UBound(orderList, 1) To LBound(orderList, 1) Step -1
        ' Find the sheet with the corresponding name
        Set ws = Worksheets(orderList(i, 1))
        On Error GoTo 0
        
        ' Move the sheet to the desired position
        If Not ws Is Nothing Then
            ws.Move Before:=Worksheets(1)
        End If
    Next i
    
    ' Enable screen updating again
    Application.ScreenUpdating = True
End Sub

@Antonino2023 

[#6]

@peiyezhu

This is exactly what I was looking for, thank you!

[#7]

You are welcome

[#8]

@Antonino2023 Hi, your macro (very useful) sorts all sheets in a workbook, is there any way to sort just some selected sheets?

[#9]

Sub SortSelectedSheets()
Dim selectedSheets
Set selectedSheets = ActiveWindow.SelectedSheets

Dim i As Long, j As Long
For i = 1 To selectedSheets.Count
For j = 1 To selectedSheets.Count - 1
If UCase$(selectedSheets(j).Name) > UCase$(selectedSheets(j + 1).Name) Then
selectedSheets(j).Move after:=selectedSheets(j + 1)
End If
Next
Next

MsgBox "The selected tabs have been sorted from A to Z."
End Sub

[#10]

@peiyezhu Thank you so much! have a great wnkd!