Sorting based on letter, and then on number

[Paul_Hossler]

Slightly more efficient version

Option Explicit


Sub drv()
    
    Call LetterNumberSort(Range("A2:A10"))


End Sub




' composed of 1 to 3 letters, and then a number, with the length of this number ranging from 1 to 5 digits.
Sub LetterNumberSort(r As Range)
    Dim c As Range
    Dim i As Long
    Dim s As String
    
    With r
        For Each c In .Cells
            Call pvtFormatToSort(c)
        Next


        With .Parent.Sort
            .SortFields.Clear
            .SortFields.Add Key:=r, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange r
            .Header = xlNo
            .MatchCase = True
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        For Each c In .Cells
            Call pvtFormatToDisplay(c)
        Next
    End With
End Sub




Private Sub pvtFormatToSort(r As Range)
    Dim s1 As String, s2 As String, s3 As String
    
    s1 = Trim(UCase(r.Value))
    
    If s1 Like "[A-Z]#*" Then
        s2 = Left(s1, 1) & "00"
        s3 = Right("00000" & Right(s1, Len(s1) - 1), 5)
        
    ElseIf s1 Like "[A-Z][A-Z]#*" Then
        s2 = Left(s1, 2) & "0"
        s3 = Right("00000" & Right(s1, Len(s1) - 2), 5)
        
    
    ElseIf s1 Like "[A-Z][A-Z][A-Z]#*" Then
        s2 = Left(s1, 3)
        s3 = Right("00000" & Right(s1, Len(s1) - 3), 5)
    End If
                
     r.Value = s2 & s3
End Sub


Private Sub pvtFormatToDisplay(r As Range)
    Dim s1 As String, s2 As String, s3 As String
    Dim i As Long
    
    s1 = r.Value
    
    If s1 Like "[A-Z]#*" Then
        i = 2
    ElseIf s1 Like "[A-Z][A-Z]#*" Then
        i = 3
    ElseIf s1 Like "[A-Z][A-Z][A-Z]#*" Then
        i = 4
    End If
        
    s2 = Left(s1, i - 1)
    
    Do While Mid(s1, i, 1) = 0
        i = i + 1
    Loop
    
    s3 = Right(s1, Len(s1) - i + 1)
            
     r.Value = s2 & s3
End Sub