Can Excel Sort Differently Than Its Default U.S. Character Set?

Question

My question is basically the opposite of THIS ONE (which had a database-based solution I can't use here).

I use SAP, which sorts characters this way:

0-9, A-Z, _

but I'm downloading data into Excel and manipulating ranges dependent on correct SAP character set sort order.

How can I force Excel to sort the same way as SAP, with underscore coming last.

After attempting a Custom Sort List of single characters in Excel's Sort feature, Excel still/always sorts like this:

_, 0-9, A-Z

Is there any way to get Excel to sort like SAP? I'm capable of doing Excel macros, if needed.

Alternatively, if anyone knows how to get native SAP tables to sort like Excel in the SAP interface, that would take care of this problem, as well.

Answer 1

EDIT: this solution is based on the automatic calculation of a custom order list, but it doesn't work if there are too many distinct values. In my case it worked with a custom order list of maybe a total of 35.000 characters, but it failed for the big list of the original poster.

---

The following code sorts the requested column(s) by ASCII value, which has this kind of order:

0-9, A-Z, _, a-z

I guess the lower case being separated from the upper case is not an issue as SAP defines values mostly in upper case. If needed, the code can be easily adapted to obtain the custom order 0-9, Aa-Zz, _ (by using UCase and worksheet.Sort.MatchCase = False).

This order is different from the built-in Excel sort order which is based on the locale. For instance, in English, it would be:

_, 0-9, Aa-Zz

The principle is to use a "custom order list" whose values are taken from the Excel column, made unique, and sorted with a QuickSort3 algorithm (subroutine MedianThreeQuickSort1 provided by Ellis Dee at http://www.vbforums.com/showthread.php?473677-VB6-Sorting-algorithms-(sort-array-sorting-arrays)).

Performance notes about the Excel sorting via custom list (I'm not talking about QuickSort3):

• The more the distinct values in the custom order list, the lower the performance. 4,000 rows having 20 distinct values are sorted immediately, but 4,000 rows having 4,000 distinct values takes 8 seconds to sort!
• For the same number of distinct values, the performance does not change a lot if there are many rows to sort. 300,000 rows having 6 distinct values takes 3 seconds to sort.

Sub SortByAsciiValue()
  With ActiveSheet.Sort
    .SortFields.Clear
    .SetRange Range("A:A").CurrentRegion
    .SortFields.Add Key:=Columns("A"), Order:=xlAscending, _
        CustomOrder:=DistinctValuesInAsciiOrder(iRange:=Columns("A"), Header:=True)
    .Header = xlYes
    .Apply
  End With
End Sub

Function DistinctValuesInAsciiOrder(iRange As Range, Header As Boolean) As String
    Dim oCell As Range
    Dim oColl As New Collection

    On Error Resume Next
    For Each oCell In iRange.Cells
        Err.Clear
        If Header = True And oCell.Row = iRange.Row Then
        ElseIf oCell.Row > iRange.Worksheet.UsedRange.Rows.Count Then
        Exit For
        Else
        dummy = oColl.Item(oCell.Text)
        If Err.Number <> 0 Then
            oColl.Add oCell.Text, oCell.Text
            totalLength = totalLength + Len(oCell.Text) + 1
        End If
        End If
    Next
    On Error GoTo 0

    If oColl.Count = 0 Then
        Exit Function
    End If

    Dim values() As String
    ReDim values(1)
    ReDim values(oColl.Count - 1 + LBound(values))
    For i = 1 To oColl.Count
        values(i - 1 + LBound(values)) = oColl(i)
    Next
    Call MedianThreeQuickSort1(values)

    ' String concatenation is complex just for better performance (allocate space once)
    DistinctValuesInAsciiOrder = Space(totalLength - 1)
    Mid(DistinctValuesInAsciiOrder, 1, Len(values(LBound(values)))) = values(LBound(values))
    off = 1 + Len(values(LBound(values)))
    For i = LBound(values) + 1 To UBound(values)
        Mid(DistinctValuesInAsciiOrder, off, 1 + Len(values(i))) = "," & values(i)
        off = off + 1 + Len(values(i))
    Next
End Function

Answer 2

The principle of the following solution is to insert a new column in which the cells have a formula which calculates a "sortable code" of each cell of the column that you want to sort.

If you sort this new column, the rows will be sorted in the ASCII order (0-9, A-Z, _).

It should be able to handle any number of rows. On my laptop, the calculation of cells takes 1 minute for 130.000 rows. There are two VBA functions, one for ASCII and one for EBCDIC. It's very easy to define other character sets.

Steps:

• Create a module in your Excel workbook and place the code below.
• Close the VB editor otherwise it will run slowly.
• In the worksheet that you want to sort, insert one column for each column you want to sort, for instance let's say the sort is to be done for column A, create a new column B, in the cell B1 insert the formula =SortableCodeASCII(A1) and do the same for all the cells of column B (up to the last row of column A).
• Make sure that the calculation of formulas is over (it takes 1 minute for 130.000 rows on my laptop), otherwise if you sort, the order will be incorrect because formulas are not yet calculated. You see the progress indicator (percentage) on the status bar at the bottom of the Excel window. If you don't see it, press Ctrl+Alt+F9.
• Sort on column B. The values in column A should be sorted according to the ASCII order (0-9, A-Z, _)

Good luck!

Option Compare Text 'to make true "a" = "A", "_" < "0", etc.
Option Base 0 'to start arrays at index 0 (LBound(array) = 0)
Dim SortableCharactersASCII() As String
Dim SortableCharactersEBCDIC() As String
Dim SortableCharactersTEST() As String

Sub ResetSortableCode()
    'Run this subroutine if you change anything in the code of this module
    'to regenerate the arrays SortableCharacters*
    Erase SortableCharactersASCII
    Erase SortableCharactersEBCDIC
    Erase SortableCharactersTEST
    Call SortableCodeASCII("")
    Call SortableCodeEBCDIC("")
    Call SortableCodeTEST("")
End Sub

Function SortableCodeASCII(text As String)
    If (Not Not SortableCharactersASCII) = 0 Then
        SortableCharactersASCII = getSortableCharacters( _
            orderedCharacters:=" !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}" & ChrW(126) & ChrW(127))
    End If
    SortableCodeASCII = getSortableCode(text, SortableCharactersASCII)
End Function

Function SortableCodeEBCDIC(text As String)
    If (Not Not SortableCharactersEBCDIC) = 0 Then
        SortableCharactersEBCDIC = getSortableCharacters( _
            orderedCharacters:=" ¢.<(+|&!$*);-/¦,%_>?`:#@'=""abcdefghi±jklmnopqr~stuvwxyz^[]{ABCDEFGHI}JKLMNOPQR\STUVWXYZ0123456789")
    End If
    SortableCodeEBCDIC = getSortableCode(text, SortableCharactersEBCDIC)
End Function

Function SortableCodeTEST(text As String)
    If (Not Not SortableCharactersTEST) = 0 Then
        SortableCharactersTEST = getSortableCharacters( _
            orderedCharacters:="ABCDEF 0123456789_")
    End If
    SortableCodeTEST = getSortableCode(text, SortableCharactersTEST)
End Function

Function getSortableCharacters(orderedCharacters As String) As String()

    'Each character X is assigned another character Y so that sort by character Y will
    'sort character X in the desired order.

    maxAscW = 0
    For i = 1 To Len(orderedCharacters)
         If AscW(Mid(orderedCharacters, i, 1)) > maxAscW Then
            maxAscW = AscW(Mid(orderedCharacters, i, 1))
         End If
    Next

    Dim aTemp() As String
    ReDim aTemp(maxAscW)
    j = 0
    For i = 1 To Len(orderedCharacters)
        'Was a character with same "sort weight" previously processed ("a" = "A")
        For i2 = 1 To i - 1
            If AscW(Mid(orderedCharacters, i, 1)) <> AscW(Mid(orderedCharacters, i2, 1)) _
                And Mid(orderedCharacters, i, 1) = Mid(orderedCharacters, i2, 1) Then
                'If two distinct characters are equal when case is ignored (e.g. "a" and "A")
                '(this is possible only because directive "Option Compare Text" is defined at top of module)
                'then only one should be used (either "a" or "A" but not both), so that the Excel sorting
                'does not vary depending on sorting option "Ignore case".
                Exit For
            End If
        Next
        If i2 = i Then
            'NO
            aTemp(AscW(Mid(orderedCharacters, i, 1))) = Format(j, "000")
            j = j + 1
        Else
            'YES "a" has same weight as "A"
            aTemp(AscW(Mid(orderedCharacters, i, 1))) = aTemp(AscW(Mid(orderedCharacters, i2, 1)))
        End If
    Next
    'Last character is for any character of input text which is not in orderedCharacters
    aTemp(maxAscW) = Format(j, "000")

    getSortableCharacters = aTemp

End Function

Function getOrderedCharactersCurrentLocale(numOfChars As Integer) As String

    'Build a string of characters, ordered according to the LOCALE order.
    '    (NB: to order by LOCALE, the directive "Option Compare Text" must be at the beginning of the module)
    'Before sorting, the placed characters are: ChrW(0), ChrW(1), ..., ChrW(numOfChars-1), ChrW(numOfChars).
    'Note that some characters are not used: for those characters which have the same sort weight
    '    like "a" and "A", only the first one is kept.
    'For debug, you may define constdebug=48 so that to use "printable" characters in sOrder:
    '    ChrW(48) ("0"), ChrW(49) ("1"), ..., ChrW(numOfChars+47), ChrW(numOfChars+48).

    sOrder = ""
    constdebug = 0 'Use 48 to help debugging (ChrW(48) = "0")
    i = 34
    Do Until Len(sOrder) = numOfChars
        Select Case constdebug + i
            Case 0, 7, 14, 15: i = i + 1
        End Select
        sCharacter = ChrW(constdebug + i)
        'Search order of character in current locale
        iOrder = 0
        For j = 1 To Len(sOrder)
            If AscW(sCharacter) <> AscW(Mid(sOrder, j, 1)) And sCharacter = Mid(sOrder, j, 1) Then
                'If two distinct characters are equal when case is ignored (e.g. "a" and "A")
                '("a" = "A" can be true only because directive "Option Compare Text" is defined at top of module)
                'then only one should be used (either "a" or "A" but not both), so that the Excel sorting
                'does not vary depending on sorting option "Ignore case".
                iOrder = -1
                Exit For
            ElseIf Mid(sOrder, j, 1) <= sCharacter Then
                'Compare characters based on the LOCALE order, that's possible because
                'the directive "Option Compare Text" has been defined.
                iOrder = j
            End If
        Next
        If iOrder = 0 Then
            sOrder = ChrW(constdebug + i) & sOrder
        ElseIf iOrder = Len(sOrder) Then
            sOrder = sOrder & ChrW(constdebug + i)
        ElseIf iOrder >= 1 Then
            sOrder = Left(sOrder, iOrder) & ChrW(constdebug + i) & Mid(sOrder, iOrder + 1)
        End If
        i = i + 1
    Loop
    'Last character is for any character of input text which is not in orderedCharacters
    sOrder = sOrder & ChrW(constdebug + numOfChars)

    getOrderedCharactersCurrentLocale = sOrder

End Function

Function getSortableCode(text As String, SortableCharacters() As String) As String

    'Used to calculate a sortable text such a way it fits a given order of characters.
    'Example: instead of order _, 0-9, Aa-Zz you may want 0-9, Aa-Zz, _
    'Will work only if Option Compare Text is defined at the beginning of the module.

    getSortableCode = ""
    For i = 1 To Len(text)
        If AscW(Mid(text, i, 1)) < UBound(SortableCharacters) Then
            If SortableCharacters(AscW(Mid(text, i, 1))) <> "" Then
                getSortableCode = getSortableCode & SortableCharacters(AscW(Mid(text, i, 1)))
            Else
                'Character has not an order sequence defined -> last in order
                getSortableCode = getSortableCode & SortableCharacters(UBound(SortableCharacters))
            End If
        Else
            'Character has not an order sequence defined -> last in order
            getSortableCode = getSortableCode & SortableCharacters(UBound(SortableCharacters))
        End If
    Next

    'For two texts "a1" and "A1" having the same sortable code, appending the original text allows using the sort option "Ignore Case"/"Respecter la casse"
    getSortableCode = getSortableCode & " " & text

End Function