Sort Sheets Numerically that contain numbers and letters in sheet name

[AKsizzle47]

Hello,

I have a lot of sheet names with numbers and letters that currently go as follows:
A10site1_1, A10site1_2, A10site2_1, A10site2_2, A11_site1_1, A11site1_2, A1site1_1, A1site1_2, A1site2_1, A1site2_2, etc (there's a lot more sheets but you get the gist)

As one can see, excel is unable to put them in numerical order. I tried codes I found online and they fail to sort the sheets properly. Can someone provide me with a macro that can make A1 come before A10 and A11? You'd think excel would just have sorting options to fix this... Thanks in advance guys I appreciate.

 

[pbornemeier]

The sheet names you showed have 2 forms
Axxsitey_z where xx is 10-99, y is 1 to 9, z is 1 to 9
Axsitey_z where x is 1-9, y is 1 to 9, z is 1 to 9
Do/can any of the sheet names differ from one or the other of these formats?

Is there any reason that forms with the second type be renamed to from values like A1site1_1 be renamed to A01site1_1 ?

 

[pbornemeier]

Assuming that:
Each sheet's name has the format ABsiteC_D
where A is a single character (not including a space)
B is any value from 1 to 999
site is a fixed alpha string
C is any value from 1 to 999
_ is always present between c and d
D is any value from 1 to 999

This code should work. Test on a copy of your data.

Option Explicit

Sub SplitNamesAndSort()

    Dim sWorksheet As String
    Dim lLastIndexerRow As Long
    Dim lWorksheetCount As Long
    Dim lX As Long
    Dim sSheetName As String
    Dim vTemp As Variant
    Dim sP1 As String
    Dim sP2 As String
    Dim sP3 As String
    Dim sP4 As String
    
    sWorksheet = "SheetIndexer"
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(sWorksheet).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = sWorksheet 'After last
    
    'New Names
    lWorksheetCount = ThisWorkbook.Worksheets.Count - 1
    For lX = 1 To lWorksheetCount
        sSheetName = Trim(Worksheets(lX).Name)
        Worksheets(sWorksheet).Cells(lX, 1).Value = Worksheets(lX).Name
        vTemp = Split(sSheetName, "site")
        sP1 = Left(sSheetName, 1)
        sP2 = Right("000" & Mid(vTemp(0), 2), 3)
        vTemp = Split(vTemp(1), "_")
        sP3 = Right("000" & vTemp(0), 3)
        sP4 = Right("000" & vTemp(1), 3)
        Worksheets(sWorksheet).Cells(lX, 2).Value = _
            sP1 & sP2 & "site" & sP3 & "_" & sP4
    Next
    
    'Sort By column B
    ActiveWorkbook.Worksheets("SheetIndexer").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SheetIndexer").Sort.SortFields.Add _
        Key:=Range("B1:B" & lWorksheetCount), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("SheetIndexer").Sort
        .SetRange Range("A1:B" & lWorksheetCount)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'Move worksheets to end
    For lX = 1 To lWorksheetCount
        Sheets(Worksheets("SheetIndexer").Cells(lX, 1).Value).Move After:=Sheets(Sheets.Count)
    Next
    
    'Delete Indexer Worksheet
    Application.DisplayAlerts = False
    Worksheets(sWorksheet).Delete
    Application.DisplayAlerts = True

End Sub