Just testing. Testing some sort routines. No reply needed

[DocAElstein]

Intermediate step coding for this post:
http://www.excelfox.com/forum/showth...ll=1#post11064
( Remember to include at top of module the global variable
Dim Rs() As Variant )

Intermediate routine

'
Sub Call_Sub_Bubbles()
' data range info
Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting")
Dim RngToSort As Range: Set RngToSort = WsS.Range("B11:E16")
                                           ' Set RngToSort = Selection '                          ' Selection.JPG : https://imgur.com/HnCdBt8

Dim arrTS() As Variant ' array to be referred to in all recursion routines, initially the original data range
 Let arrTS() = RngToSort.Value
 Let Rs() = Evaluate("=Row(1:6)") ' ' Initial row indicies
 Call Bubbles(1, arrTS(), " 1 Asc 3 Asc 2 Asc ")

' Demo output
 Let WsS.Range("B31").Resize(RngToSort.Rows.Count, RngToSort.Columns.Count).Value = arrTS()
End Sub
'
Sub Bubbles(ByVal CpyNo As Long, ByRef arsRef() As Variant, 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.  This ensures we then have the correct value place at the start of any newly starting copy of the recursion routine, since the first copy of the recursion routine pauses and starts the second copy of the recursion routine, the second copy of the recursion routine pauses and starts the third copy of the recursion routine ….. etc…
                                                                             If CopyNo = 1 Then Debug.Print "First procedure Call"
Rem -1 from the supplied  arguments, get all data needed in current bubble sort
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 ...... ' Column for this level sort , and Ascending or Descending - both determined from the supplied forth arguments and the column/ copy number
                                                                             If (2 * CopyNo) > UBound(Keys()) + 1 Then Debug.Print "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

Rem 1 Bubble sort
Dim rOuter As Long ' ========"Left Hand"=====================Outer Loop=====================================
    For rOuter = Rs(LBound(Rs(), 1), 1) To Rs(UBound(Rs(), 1), 1) - 1 ' For first row indicie to last but one row indicie
    Dim rInner As Long ' -------Inner Loop-------------"Right Hand"--------------------------
        For rInner = rOuter + 1 To Rs(UBound(Rs(), 1), 1) ' from just above left hand through all the rest
            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
        Next rInner ' -----------------------------------------------------------------------
    Next rOuter ' ==========================================================================================


End Sub