I am thinking of an alternative approach, the idea being to reduce on the steps to reorganising the array at every swap stage.. the idea came from 2 things …
_1 The recursion routine is fed currently the row indices of the rows that need to be sorted.
_2 We can use the VBA Application.Index Method which allows us to re sort an array “ in one go “ via a code line like , pseudo formula..
arrOut() = App.Indx( ArrIn() , {1;3;2} , {1,2,3} )
arrOut() = App.Indx( ArrIn() , row indices , column indicies )
arrOut() = App.Indx( ArrIn() , Rs() , Cms() )
The above code line would change an ArrIn() like this …_
A b c
D e f
G h I
_ … to a given output in arrOut() like this:
A b c
G h I
D e f
So the idea is that we sort the indices values, and then re apply the formula above
At this stage I propose modifying the existing code so as to have a better chance of a direct comparison in performance.. Both will be then subject to similar general inefficiencies arising from the very opened out explicit form of the codlings generally. I will do two version of this code, Sub SimpleArraySort7( and Sub SimpleArraySort8(
Sub SimpleArraySort7( will add the extra coding, and Sub SimpleArraySort8( will remove some of the now unnecessary / redundant parts thereafter, so as to attempt a good comparison to the previous Sub SimpleArraySort6(
Finally I may make a more trimmed version
Here the basic modifications for Sub SimpleArraySort7(__ , Sub TestieSimpleArraySort7()
Global Variables
To help simplify the comparison and so reduce the changes to the routines, I will have a some Global variables at the top of the module and outside any routine for the row and column indices
Dim Cms() As Variant, Rs() As Variant
This will allow me to refer to, that is to say change and use, in any copy of the recursion routine. (It would also be an alternative place here at the top of the module and outside any routine for our main array, arrTS(): we could then always refer to this, and then not need the ByRef arsRef() at the signature line of the recursion routine. But for now I will leave that as it is for closer comparison of the routines. )
These two “single width” arrays,
_ Rs() , “vertical, rows”
and
_ Cms() , “horizontal columns”
, will hold whole number indices for use in the VBA Index method formula idea.
For the type of the elements of these arrays, the Long type would be OK, and also in such situations VBA usually accepts Sting types that look like an number. The only reason that I use Variant is that I use a convenient way to get the initial indices, and that way happens to return a field of Variant types
To help in the development of this coding and to help with the explanation here, I have also moved the variable for the test range, RngToSort , to the top of the module and outside any routine to make it a global variable: This way I can use multiples of it’s dimensions to position intermediate paste outs of the arrTS(). For example , I have added a section immediately after the end of the main outer loop == for sorting, ' Captains Blog, Start Treck , which pastes out the current state of the sorted array , arrTS(), along with the current state of the indices, Rs()
Code:
' Captains Blog, Start Treck
Let RngToSort.Offset((RngToSort.Rows.Count * (CopyNo + 1)), 0).Value = arsRef()
RngToSort.Offset((RngToSort.Rows.Count * (CopyNo + 1)), -1).Resize(UBound(Rs(), 1), UBound(Rs(), 2)).Value = Rs()
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
For Sub SimpleArraySort7(__ , I will also include a new array variable , as a global variable, arrIndx(). This I will fill by the formula line of
arrIndx() = Application.Index(arrOrig(), Rs(), Cms())
The formula above needs to be applied to the original range, so I also have another global variable which will contain the original range, arrOrig()
The final output, for example from the first passing of this section, can be seen here:
http://www.excelfox.com/forum/showth...ll=1#post11049
In that screenshot the output from the previous routines produced in
__arsRef()
is shown and , for comparison, alongside it is shown that produced by
______________arrIndx() = Application.Index(arrIndx(), Rs(), Cms())
Modifying indices values in main sort loop sorting
In other words, how do we get the modified Rs() to use in
arrIndx() = Application.Index(arrIndx(), Rs(), Cms())
The way the current coding is organised makes this fairly simple. We have sections where all column elements in a row are swapped.
__ 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
We use the row information in the variables rOuter and rInner. So quite simply, we do the same swap for row indices,
Dim TempRs As Long
_ TempRs = Rs(rOuter, 1): Let Rs(rOuter, 1) = Rs(rInner, 1): Let Rs(rInner, 1) = TempRs
With those simple modifications we obtain for the final full run the results shown here:
http://www.excelfox.com/forum/showth...ll=1#post11050
Summary
In the next post the actual modifications to transform Sub SimpleArraySort6( to Sub SimpleArraySort7( are walked through in a bit more detail. Here is the brief summary to help in orienteering.
In the previous recursion routines, ( and still in this intermediate version, Sub SimpleArraySort7( ) the entire row values are swapped at various stags in the Bubble sort process. In our codings so far, we had typical sections like this
Code:
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
In that above snippet, every column value in a row goes through the typical three line swap using a temporary variable: __ temp=My1 _ My1=My2 _ My2=temp https://excel.tips.net/T002525_Swapp...o_Numbers.html
For the new coding idea, we only need to swap the row indices so as to change their order from like {1;2;3;4….} to the new sorted order like ModifiedRowIndicies ={2;1;4;3….}, since then we will apply the idea .._
__ arrNext() = App.Indx( originalRange , rows() , columns() )
__ arrNext() = App.Indx(originalRange, ModifiedRowIndicies , {1,2,3,4,…..})
_.. to get the modified row order from the original range. ( The columns, columns() , remain in the original order , {1,2,3,4,…..} )
So we have an extra code line which just swaps the row indicia. ( In this intermediate version I still include the previous swap sections )
Code:
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
Dim TempRs As Long
Let TempRs = Rs(rOuter, 1): Let Rs(rOuter, 1) = Rs(rInner, 1): Let Rs(rInner, 1) = TempRs
The main other extra code section is then the code line to get the new row order using the reordered row indices
___ arrIndx() = Application.Index(arrOrig(), Rs(), Cms() )
This done at the end of the sort section
Code:
Next rInner ' ---------------------------------------------------------------------
Next rOuter ' ===========================================================================================
Debug.Print "Doing an arrIndx()"
Let arrIndx() = Application.Index(arrOrig(), Rs(), Cms())
' Captains Blog, Start Treck
Bookmarks