Code:
'
' Main recursion routine below : Bubble Sorting in Arrays using multi columns values for sort criteria
Sub SimpleArraySort6(ByVal CpyNo As Long, ByRef arsRef() As Variant, ByVal strRws As String, ByVal strKeys As String)
Dim CopyNo As Long: Let CopyNo = CpyNo ' On every recurssion run this will be increased by the Rec Call. This will be a local variable indicating the level down in recursion - I increase it by 1 at every Rec Call, that is to say each Rec Call gets given CopyNo+1  -  during a long tunnel down, the number at this pint will keep increasing to reflect how far down we are
    If CopyNo = 1 Then Debug.Print "First procedure Call"
Rem -1 from the supplied  arguments, get all data needed in current bubble sort
' Column for this level sort , and Ascending or Descending - both determined from the supplied forth arguments and the column/ copy number
Dim Keys() As String: Let Keys() = Split(Replace(Trim(strKeys), "  ", " ", 1, -1, vbBinaryCompare), " ", -1, vbBinaryCompare) ''      The extra replace allows for me seperating with one or two spaces  - the following would do if I only used one space always    Split(Trim(strKeys), " ", -1, vbBinaryCompare) ' this will be an array twice as big as the number of keys that we have
    If (2 * CopyNo) > UBound(Keys()) + 1 Then MsgBox Prompt:="You need more than " & (UBound(Keys()) + 1) / 2 & " keys to complete sort": Exit Sub ' case we have less keys then we need to sort, are array has twice as many elements as we have supplied keys since we have a key and whether it needs to get bigger or smaller , and array is from  0   so must add 1 to ubound then half it get the key number we gave.  We come here if the last column we gave as a Key had duplicates in it
Dim GlLl As Long: If Keys((CopyNo * 2) - 1) = "Desc" Then Let GlLl = 1 ' (CopyNo * 2) - 1)  gives as we go down levels   1  3  5  7 etc  We're seeing if we had  Desc  for this column
Dim Clm As Long: Let Clm = CLng(Keys((CopyNo * 2) - 2)) '              ' (CopyNo * 2) - 2)  gives as we go down levels   0  2  4  6 etc  We  are  picking  out  the  supplied   column to sort by for each level
' making an array from the " 3 4 5 6 " string is just for convenience later of getting the upper and lower row numbers
Dim Rws() As String: Let Rws() = Split(Trim(strRws), " ", -1, vbBinaryCompare) ' We take the supplied sequential string   2 3 4 5 6   and make a 1 D array {1, 2, 3....} as it is a bit more conveniant to work with.  Actually we only need the start and top numbers so we could do it with stinr manipulation instead
Rem 1 Simple Bubble Sort
Dim rOuter As Long ' ========"Left Hand"=====================Outer Loop=====================================
    For rOuter = Rws(LBound(Rws())) To Rws(UBound(Rws()) - 1) ' For first row indicie to last but one row indicie
    Dim rInner As Long ' -------Inner Loop-------------"Right Hand"--------------------------
        For rInner = rOuter + 1 To Rws(UBound(Rws())) ' from just above left hand through all the rest
            If GlLl = 0 Then ' We want Ascending list
                If IsNumeric(arsRef(rOuter, Clm)) And IsNumeric(arsRef(rInner, Clm)) Then ' Numeric case
                    If CDbl(arsRef(rOuter, Clm)) > CDbl(arsRef(rInner, Clm)) Then
                    Dim Temp As Variant ' I want to Swap those 2 above - I cant easilly in any coding change two values simulataneosly. So one of them Element values will put in this temporary place. This Element Values will then be given the other. Finally the other Element will be given this temporary value
                    Dim Clms As Long '-------| with the condition met  a loop is done for all columns in the array in which those two values used in the comparison are replaced at each column
                        For Clms = 1 To UBound(arsRef(), 2)
                         Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp
                        Next Clms '----------| for each column in the array at the two rows rOuter and rInner
                    Else
                    End If
                 Else ' Non numeric case
                    If UCase(CStr(arsRef(rOuter, Clm))) > UCase(CStr(arsRef(rInner, Clm))) Then
                        For Clms = 1 To UBound(arsRef(), 2)
                         Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp
                        Next Clms '----------| for each column in the array at the two rows rOuter and rInner
                    Else
                    End If
                End If ' End of numeric or text comparison
            Else ' GlLl is not 0 , so presumably we want Descending list
                If IsNumeric(arsRef(rOuter, Clm)) And IsNumeric(arsRef(rInner, Clm)) Then
                    If CDbl(arsRef(rOuter, Clm)) < CDbl(arsRef(rInner, Clm)) Then
                        For Clms = 1 To UBound(arsRef(), 2)
                         Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp
                        Next Clms '----------| for each column in the array at the two rows rOuter and rInner
                    Else
                    End If
                Else ' non numeric case
                    If UCase(CStr(arsRef(rOuter, Clm))) < UCase(CStr(arsRef(rInner, Clm))) Then
                        For Clms = 1 To UBound(arsRef(), 2)
                         Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp
                        Next Clms '----------| for each column in the array at the two rows rOuter and rInner
                    Else
                    End If
                End If ' End of numeric or text comparison
            End If ' End of Ascending or Descending example
        Next rInner ' ---------------------------------------------------------------------
    Next rOuter ' ===========================================================================================
' Captains Blog, just fo info
 Debug.Print " Running Copy " & CopyNo & " of routine." & vbCr & vbLf & "  Sorted rows " & strRws & " based on values in column " & Clm & vbCr & vbLf & "   Checking now for Dups in that last sorted list" & vbCr & vbLf
' Rem 3 Determine any duplicates in sort column values , and re run the routine to sort them by another column
 Let rOuter = Rws(LBound(Rws())) - 1 ' we look for duplicates in the current list, in the loop below we add 1 each time so _ it  is necersarry to start 1 before,  so that +1 the first time is the start row
 Let strRws = "" ' ready for use in duplicate search
    Do ' Loop down the last set of sorted rows ****************************************************|
     Let rOuter = rOuter + 1 ' next row number                                                                             _ it was necersarry to start 1 before,  so that +1 the first time is the start row
        If strRws = "" Or Trim(strRws) = rOuter - 1 Then Let strRws = " " & rOuter & " " ' case starting again to get duplicates
        If Trim(UCase(CStr(arsRef(rOuter, Clm)))) = Trim(UCase(CStr(arsRef(rOuter + 1, Clm)))) Then ' case in duplicate rows
         Let strRws = strRws & rOuter + 1 & " " ' we building a list like   " 4 5 6 "  based on if the next is a duplicate value, which is determined by the last line
        Else ' when we did not have a next duplicate, we may have a few already grouped
            If Not InStr(1, Trim(strRws), " ", vbBinaryCompare) = 0 Then ' case we have at least 2 duplicates but have hit end of that list
             Debug.Print "Found dups in last list column " & Clm & ", " & strRws & " , so now Rec Call 1" '     This is done for every duplicated value section, except if we have duplicates at the last lines
             Call SimpleArraySort6(CopyNo + 1, arsRef(), strRws, strKeys) ' Rec Call 1  I need to sort the last duplicates
             Let strRws = "" ' ready to try for another set of duplicates
            Else
            End If
        End If ' this is the end of the stuff in most situations...
        ' ...below section catches rows at the end that might need to be sorted. ......|
        If rOuter = UBound(arsRef(), 1) - 1 And Not InStr(1, Trim(strRws), " ", vbBinaryCompare) = 0 Then ' case of duplicates in last row
         Debug.Print "Found dups in last list, so now Rec Call 2 (Dups at list end case)"  ' Rec Call 2 - only done for duplicates at end of list
         Call SimpleArraySort6(CopyNo + 1, arsRef(), strRws, strKeys)
        Else
        End If  '...   ................................................................|
    Loop While rOuter <> Rws(UBound(Rws()) - 1) ' keep looking for Duplicates in next row**********|
End Sub
Typical results in the next post: