Change current VBA code to sort differently

did you try :
record a macro,
run your new sort,
stop macro.

now you have a new sort macro.

I was hoping that a Custom List could be used for sorting. Unfortunately, I was disappointed with the sorting behavior using the list.
Below is a somewhat wonky macro that should sort the data in each column in the order you expect.

Sub SortColumnsAlphabetically()
    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long
    Dim lastCol As Long
    Dim col As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' Define the worksheet (change "Data List" to your actual sheet name)
    Set ws = ThisWorkbook.Sheets("Data List")
    
    ' Define the range (A3:E27 in this case)
    Set rng = ws.Range("A3:E27")
    
    ' Find the last row and last column in the range
    lastRow = rng.Rows.Count + rng.Row - 1
    lastCol = rng.Columns.Count + rng.Column - 1
    
    ' Loop through each column and sort it alphabetically
    For col = rng.Column To lastCol
        ws.Range(ws.Cells(rng.Row, col), ws.Cells(lastRow, col)).Sort _
            Key1:=ws.Cells(rng.Row, col), _
            Order1:=xlAscending, _
            Header:=xlNo
        
        Call SortCustom(ws.Range(ws.Cells(rng.Row, col), ws.Cells(lastRow, col)))
    Next col
    
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
End Sub


Sub SortCustom(rng As Range)
    Dim NumCount As Long
    Dim SymbCount As Long
    Dim AlphaCount As Long
    
    Dim v As Variant
    Dim vSymbols As Variant
    Dim vAlpha As Variant
    Dim vNum As Variant
    
    Dim i As Long
    
    v = rng.Value
    
    'how many numbers in range
    NumCount = Application.Count(v)
    
    'look for position of last symbol
    For i = NumCount + 1 To UBound(v)
      If Not IsEmpty(v(i, 1)) Then
        If Asc(LCase(v(i, 1))) >= 97 Then
            i = i - 1
            Exit For
        End If
      End If
    Next i
    
    'how many symbols
    SymbCount = Application.Min(i, UBound(v)) - NumCount
    'how many alpha
    AlphaCount = UBound(v) - NumCount - SymbCount
    
    'remove empty elements (if any) from the arrays vNum, vSymbols, vAlpha
    If NumCount > 0 Then
        vNum = rng(1).Resize(NumCount)
        
        For i = UBound(vNum) To 1 Step -1
            If Not IsEmpty(vNum(i, 1)) Then
                Exit For
            End If
        Next i
        
        If i > 0 Then
            vNum = rng(1).Resize(i)
        End If
    End If
    
    
    If SymbCount > 0 Then
        vSymbols = rng(NumCount + 1).Resize(SymbCount)
        
        For i = UBound(vSymbols) To 1 Step -1
            If Not IsEmpty(vSymbols(i, 1)) Then
                Exit For
            End If
        Next i
        
        If i > 0 Then
            vSymbols = rng(NumCount + 1).Resize(i)
        End If
    End If
    
    
    If AlphaCount > 0 Then
        vAlpha = rng(NumCount + SymbCount + 1).Resize(AlphaCount)
        
        For i = UBound(vAlpha) To 1 Step -1
            If Not IsEmpty(vAlpha(i, 1)) Then
                Exit For
            End If
        Next i
        
        If i > 0 Then
            vAlpha = rng(NumCount + SymbCount + 1).Resize(i)
        End If
    End If
    
    'recalculate the count of each character group
    On Error Resume Next
    NumCount = 0
    NumCount = UBound(vNum)
    SymbCount = 0
    SymbCount = UBound(vSymbols)
    AlphaCount = 0
    AlphaCount = UBound(vAlpha)
    
    'insert data into the range in order: Alpha, Numeric, Symbols
    rng(1).Resize(AlphaCount).Value = vAlpha
    rng(AlphaCount + 1).Resize(NumCount).Value = vNum
    rng(AlphaCount + NumCount + 1).Resize(SymbCount).Value = vSymbols
    On Error GoTo 0
    
End Sub

Artik