excelvbacustomizationsap-guicharacter-set

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


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.


Solution

  • 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:

    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