22

I have defined the following Array Dim myArray(10,5) as Long and would like to sort it. What would be the best method to do that?

I will need to handle a lot of data like a 1000 x 5 Matrix. It contains mainly numbers and dates and need to sort it according to a certain column

Jean-François Corbett
  • 37,420
  • 30
  • 139
  • 188
BlackLabrador
  • 321
  • 2
  • 3
  • 6
  • 1
    See the accepted answer to [this question](http://stackoverflow.com/questions/152319/vba-array-sort-function). I don't exactly know *how* you want to sort it, but you can modify that implementation of the QuickSort algorithm however you need. – Cody Gray - on strike Feb 02 '11 at 10:22
  • 1
    Hi BlackLabrador, I think we might need a little more information about what exactly you want to do here... Are you trying to sort all 50 items into one long list, or sort by a 'column', or by a 'row', or some other way? If you edit your post to include this sort of information you're much more likely to get more/more useful answers. – Simon Cowen Feb 02 '11 at 17:14
  • Thanks for your comments. Will have a look to Cody's link – BlackLabrador Feb 03 '11 at 02:56

9 Answers9

45

Here's a multi-column and a single-column QuickSort for VBA, modified from a code sample posted by Jim Rech on Usenet.

Notes:

You'll notice that I do a lot more defensive coding than you'll see in most of the code samples out there on the web: this is an Excel forum, and you've got to anticipate nulls and empty values... Or nested arrays and objects in arrays if your source array comes from (say) a third-party realtime market data source.

Empty values and invalid items are sent to the end of the list.

To sort multi-column arrays, your call will be:

 QuickSortArray MyArray,,,2
...Passing '2' as the column to sort on and excluding the optional parameters that pass the upper and lower bounds of the search domain.

Sorting single-column arrays (vectors), instead use:

QuickSortVector Myarray
Here too excluding the optional parameters.

[EDITED] - fixed an odd formatting glitch in the <code> tags, which seem to have a problem with hyperlinks in code comments.

The Hyperlink I excised was Detecting an Array Variant in VBA.

Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0)
    On Error Resume Next

    'Sort a 2-Dimensional array

    ' SampleUsage: sort arrData by the contents of column 3
    '
    '   QuickSortArray arrData, , , 3

    '
    'Posted by Jim Rech 10/20/98 Excel.Programming

    'Modifications, Nigel Heffernan:

    '       ' Escape failed comparison with empty variant
    '       ' Defensive coding: check inputs

    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim arrRowTemp As Variant
    Dim lngColTemp As Long

    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray, 1)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray, 1)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If

    i = lngMin
    j = lngMax

    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)

    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If

    While i <= j
        While SortArray(i, lngColumn) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j, lngColumn) And j > lngMin
            j = j - 1
        Wend

        If i <= j Then
            ' Swap the rows
            ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
            For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
                arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
                SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
                SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
            Next lngColTemp
            Erase arrRowTemp

            i = i + 1
            j = j - 1
        End If
    Wend

    If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
    If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)
    
End Sub

... And the single-column array version:

Public Sub QuickSortVector(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1)
    On Error Resume Next

    'Sort a 1-Dimensional array

    ' SampleUsage: sort arrData
    '
    '   QuickSortVector arrData

    '
    ' Originally posted by Jim Rech 10/20/98 Excel.Programming


    ' Modifications, Nigel Heffernan:
    '       ' Escape failed comparison with an empty variant in the array
    '       ' Defensive coding: check inputs

    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim varX As Variant

    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If

    i = lngMin
    j = lngMax

    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2)

    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If

    While i <= j

        While SortArray(i) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j) And j > lngMin
            j = j - 1
        Wend

        If i <= j Then
            ' Swap the item
            varX = SortArray(i)
            SortArray(i) = SortArray(j)
            SortArray(j) = varX

            i = i + 1
            j = j - 1
        End If

    Wend

    If (lngMin < j) Then Call QuickSortVector(SortArray, lngMin, j)
    If (i < lngMax) Then Call QuickSortVector(SortArray, i, lngMax)

End Sub

I used to use BubbleSort for this kind of thing, but it slows down, severely, after the array exceeds 1024 rows. I include the code below for your reference: please note that I haven't provided source code for ArrayDimensions, so this will not compile for you unless you refactor it - or split it out into 'Array' and 'vector' versions.

Public Sub BubbleSort(ByRef InputArray, Optional SortColumn As Integer = 0, Optional Descending As Boolean = False)
' Sort a 1- or 2-Dimensional array.

Dim iFirstRow   As Integer
Dim iLastRow    As Integer
Dim iFirstCol   As Integer
Dim iLastCol    As Integer
Dim i           As Integer
Dim j           As Integer
Dim k           As Integer
Dim varTemp     As Variant
Dim OutputArray As Variant

Dim iDimensions As Integer

iDimensions = ArrayDimensions(InputArray)

    Select Case iDimensions
    Case 1

        iFirstRow = LBound(InputArray)
        iLastRow = UBound(InputArray)
        
        For i = iFirstRow To iLastRow - 1
            For j = i + 1 To iLastRow
                If InputArray(i) > InputArray(j) Then
                    varTemp = InputArray(j)
                    InputArray(j) = InputArray(i)
                    InputArray(i) = varTemp
                End If
            Next j
        Next i
        
    Case 2

        iFirstRow = LBound(InputArray, 1)
        iLastRow = UBound(InputArray, 1)
        
        iFirstCol = LBound(InputArray, 2)
        iLastCol = UBound(InputArray, 2)
        
        If SortColumn  InputArray(j, SortColumn) Then
                    For k = iFirstCol To iLastCol
                        varTemp = InputArray(j, k)
                        InputArray(j, k) = InputArray(i, k)
                        InputArray(i, k) = varTemp
                    Next k
                End If
            Next j
        Next i

    End Select
        

    If Descending Then
    
        OutputArray = InputArray
        
        For i = LBound(InputArray, 1) To UBound(InputArray, 1)
        
            k = 1 + UBound(InputArray, 1) - i
            For j = LBound(InputArray, 2) To UBound(InputArray, 2)
                InputArray(i, j) = OutputArray(k, j)
            Next j
        Next i
 
        Erase OutputArray
        
    End If

End Sub

This answer may have arrived a bit late to solve your problem when you needed to, but other people will pick it up when they Google for answers for similar problems.

Tim Stack
  • 3,209
  • 3
  • 18
  • 39
Nigel Heffernan
  • 4,636
  • 37
  • 41
  • 1
    Why does the QuickSortArray Sub flip the columns? The resulting array is a mirror of the original, but sorted. – lukehawk Apr 28 '16 at 21:41
  • @lukehawk - I can't reproduce that, and there's nothing in the 'row swapper' loop that would obviously do it: can you expand on your point so I can look into this in a bit more depth? – Nigel Heffernan Apr 29 '16 at 08:58
  • @lukehawk +1 on the comment, your question directed my attention to a badly-placed `Redim` in the `While i <= j` loop: that's an allocation, it's **slow** and it should only be done once, outside the loop. – Nigel Heffernan Apr 29 '16 at 09:02
  • 1
    Sorry, Nile. I had an array with the dimensions backwards, and it was sorting the columns, not the rows. Kind of a weird one-off. Your code is fine. Apologies for the mix-up. So just to be clear, the Redim on the arrRowTemp should be outside the while loop? Since you just need to allocate the memory once, and over-write it every time after that? – lukehawk Apr 29 '16 at 12:37
  • @lukehawk *Since you just need to allocate the memory once* - Exactly. Or at least, once within each function call - you wouldn't get away with declaring it at module level! - as each function instance in the recursing call stack needs its own local block of memory, and I don't quite trust the VBA compiler to manage that without explicit direction. – Nigel Heffernan Apr 29 '16 at 14:57
  • great function but bit of a bug when the array contains empty values (e.g. from a workbook range), it will set i = max and stops. – David Oct 27 '16 at 22:25
  • I could only used it calling it this way: QuickSortArray usefulData, -1, -1, 5 If I don't add -1,-1, it wasn't working for me. Also, works great to sort by one column... How can we make it work if we want to sort, first by one column, and then by another? – сами J.D. Jan 16 '17 at 17:27
  • @сами J.D. Odd. I'll see if I can reproduce that... Hierarchical sort wasn't worth implementing in VBA: I would just drop the data into a disconnected recordset object and sort it using the ADODB.Sort – Nigel Heffernan Jan 17 '17 at 15:52
  • 1
    This is a good solution, but DONT FORGET TO SET `Option Base 1` if your array was defined as the same. When I sort a 2-d array with one value of the second column (also the sorting column) is zero. After the sorting completed the value of the first column was also set to zero. I spent almost two hours on this. Finally it became all right after I set `Option Base 1` to the module. – Phil Jan 24 '18 at 09:14
  • @Phil - Apologies for that: I'll see if I can reproduce the bug, then fix it as soon as I have time. I *thought* my code handled both zero- an 1-based arrays correctly, and you can get either in Excel VBA. – Nigel Heffernan Jan 24 '18 at 10:28
  • @Nigel Heffernan Thanks for feedback. This already helps me a lot. My comment is just a remind for other users. Good day with a up vote. – Phil Jan 24 '18 at 10:38
  • 1
    For QuickSortArray() I suggest to define `Optional lngColumn As Long = -1` (not `0`) and add `If lngColumn = -1 Then lngColumn = LBound(SortArray)` to get a defined result in each case. For me the code then works fine regardless of `Option Base` setting (but may not have tested all eventualities). I also added `If lngColumn < LBound(SortArray) Then lngColumn = LBound(SortArray)` and `If lngColumn > UBound(SortArray) Then lngColumn = UBound(SortArray)` but this may be a matter of taste. – martin.lindenlauf Sep 04 '19 at 20:45
  • 1
    Sorting the Array by the code above is not permanent. So first sorting it for column 1 and then sorting it for column 2 will not keep the order from column 1 for similar values in column 2. It alsways seems to start with the original SortArray. Is there a way to make the sorting permanent (e.g. make the code a function, assign the sorted array to a new variable and then run the sorting function for the already sorted array? – Geole Mar 06 '21 at 12:39
  • 1
    @Geole - Yes, it's written on the assumption that the array is going to be sorted, and re-sorted, in-place; and I made a deliberate design decision *not* to copy and create a new array, with all the associated overhead of allocation and doubling the memory 'footprint' - that's why I use a subroutine with a reference to the array, not a function returning a new array. If that's what your code actually needs, then you'll have to do a bit of refactoring and reconfigure this as a function taking the InputArray parameter (still by reference!), and declaring and returning an 'OutputArray' variant. – Nigel Heffernan Mar 12 '21 at 11:25
  • How could this be modified to sort descending rather than ascending? I'm having a hard time getting my head around this... – Alastair Apr 21 '21 at 14:34
  • Hi @Alastair - if you get a direction parameter to work, feel free to post your code here! You would need to encapsulate the comparisons in the `While i <= j` loop, and the two subsequent recursions, in an IF statement with the `If Left(SortDirection,3) = "ASC" Then` branch identical to the current code, and the `ELSE` branch comparisons reversed, so the ` > ` signs are ` < ` and vice versa - but the difficulty in doing that, is knowing that some of them need to be ` <= ` and that'll need testing. Also: the ASC or DESC parameter would have to be passed into the recursive calls, too. – Nigel Heffernan Apr 22 '21 at 15:37
  • 1
    Why that awful "On Error Resume Next" on the beginning? – 6diegodiego9 Aug 05 '22 at 07:20
  • @6diegodiego9 - The Resume Next is there because each one of the code samples has use-cases which have *no* viable error-handling in VBA. – Nigel Heffernan Aug 17 '22 at 14:47
  • 1
    @Nigel Heffernan The code in its current form will fail if we have objects inside the array. E.g. I had 2 columns with 1) dates and 2) user-defined class objects. After using the function, some lines had the class objects replaced by 'Empty'. To fix that, I changed the code to have two versions of the swapping depending on `IsObject(arr(i, lngColTemp))` (if true, I add the `Set`). – Adrian B. Oct 19 '22 at 23:25
  • 1
    @AdrianB. - I've had a quick look at my first attempt at replying to your point, and I think you're entitled to a more precise answer. So: the first reason I exclude anything that tests true on `IsObject` is to simplify the code! But the second reason is that most objects encountered by an Excel user have a default property, and the comparison operator '>' extracts and coerces a default a scalar variant that works here: `SortArray(i) < varMid`. It worked a decade ago, when I tested that with recordset fields and single-cell ranges, which most Excel users conceptualise as values, not objects. – Nigel Heffernan Oct 21 '22 at 09:51
  • @AdrianB. Whether it still works today is another question: that `If IsObject()` test may well be a problem when it reads a range object reference into `varMid` instead of the its default property, the variant `Range.Value`! But any 'solutions' to that will be complex, and likely to exclude usable data points from the sort operation wherever the native functionality of `>` makes a decent job of handling objects with a default value... And your user-defined class objects can, and should, have a default value: http://www.cpearson.com/excel/DefaultMember.aspx – Nigel Heffernan Oct 21 '22 at 10:02
  • @Nigel Heffernan thanks for your reply and for the initial algorithm :). Maybe you could add a note for those that may fall on the same situation as me? It took me some time to find that the problem was not me misunderstanding how to use the function but the incompatibility of the data in my array. Maybe something like "Note: if some data in your array is changed to 'Empty' after using this function, it may be because of [this] and you can [do this / look into this] to fix it" ? – Adrian B. Oct 21 '22 at 21:35
  • Thx, Works like a charm. 0.58 sec for a (65000 x 15) area !! – hornetbzz Dec 14 '22 at 14:39
8

The hard part is that VBA provides no straightforward way to swap rows in a 2D array. For each swap, you're going to have to loop over 5 elements and swap each one, which will be very inefficient.

I'm guessing that a 2D array is really not what you should be using anyway though. Does each column have a specific meaning? If so, should you not be using an array of a user-defined type, or an array of objects that are instances of a class module? Even if the 5 columns don't have specific meanings, you could still do this, but define the UDT or class module to have just a single member that is a 5-element array.

For the sort algorithm itself, I would use a plain ol' Insertion Sort. 1000 items is actually not that big, and you probably won't notice the difference between an Insertion Sort and Quick Sort, so long as we've made sure that each swap will not be too slow. If you do use a Quick Sort, you'll need to code it carefully to make sure you won't run out of stack space, which can be done, but it's complicated, and Quick Sort is tricky enough already.

So assuming you use an array of UDTs, and assuming the UDT contains variants named Field1 through Field5, and assuming we want to sort on Field2 (for example), then the code might look something like this...

Type MyType
    Field1 As Variant
    Field2 As Variant
    Field3 As Variant
    Field4 As Variant
    Field5 As Variant
End Type

Sub SortMyDataByField2(ByRef Data() As MyType)
    Dim FirstIdx as Long, LastIdx as Long
    FirstIdx = LBound(Data)
    LastIdx = UBound(Data)

    Dim I as Long, J as Long, Temp As MyType
    For I=FirstIdx to LastIdx-1
        For J=I+1 to LastIdx
            If Data(I).Field2 > Data(J).Field2 Then
                Temp = Data(I)
                Data(I) = Data(J)
                Data(J) = Temp
            End If
        Next J
    Next I
End Sub
Steve Jorgensen
  • 11,725
  • 1
  • 33
  • 43
  • You are, of course, sorting a vector of records. **If only** there was some readily-available library that captured tabulated data in a 'Recordset', indexed it with a BTree, and called a compiled-to-the-metal 'Sort' function... :o) – Nigel Heffernan Apr 29 '16 at 09:09
4

This is a tough one since it depends on many parameters, but after analyzing many algorithms I go with this one that overall has a stellar performance. On my machine which is not really fast, I sorted a 3 column array with 100k rows in 1 second. I tried fewer rows and it was a split second, however for one million rows I got between 9 and 26 seconds with different data (percentage of unsorted data has an impact anyway).

One routine for Ascending and one for Descending sorting. iCol, which is the 2nd argument is the index of the column on which the array is supposed to be sorted.

Public Sub MedianThreeQuickSort1_2D_Asc(ByRef pvarArray As Variant, _
                                        ByVal iCol As Integer, _
                                            Optional ByVal plngLeft As Long, _
                                                Optional ByVal plngRight As Long)
'Grade A+
'NOTE: recursive routine, omit plngLeft & plngRight; they are used internally during recursion
    Dim j As Integer
    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim lngIndex As Long
    Dim varSwap As Variant
    Dim a As Long
    Dim b As Long
    Dim c As Long
    
    If plngRight = 0 Then
        plngLeft = LBound(pvarArray, 1)
        plngRight = UBound(pvarArray, 1)
    End If
    
    lngFirst = plngLeft
    lngLast = plngRight
    lngIndex = plngRight - plngLeft + 1
    a = Int(lngIndex * Rnd) + plngLeft
    b = Int(lngIndex * Rnd) + plngLeft
    c = Int(lngIndex * Rnd) + plngLeft
    If pvarArray(a, iCol) <= pvarArray(b, iCol) And pvarArray(b, iCol) <= pvarArray(c, iCol) Then
        lngIndex = b
    Else
        If pvarArray(b, iCol) <= pvarArray(a, iCol) And pvarArray(a, iCol) <= pvarArray(c, iCol) Then
            lngIndex = a
        Else
            lngIndex = c
        End If
    End If
    
    varMid = pvarArray(lngIndex, iCol)
    Do
        Do While pvarArray(lngFirst, iCol) < varMid And lngFirst < plngRight
            lngFirst = lngFirst + 1
        Loop
        Do While varMid < pvarArray(lngLast, iCol) And lngLast > plngLeft
            lngLast = lngLast - 1
        Loop
        
        If lngFirst <= lngLast Then
            For j = LBound(pvarArray, 2) To UBound(pvarArray, 2)
                varSwap = pvarArray(lngLast, j)
                pvarArray(lngLast, j) = pvarArray(lngFirst, j)
                pvarArray(lngFirst, j) = varSwap
            Next j
            
            lngFirst = lngFirst + 1
            lngLast = lngLast - 1
        End If
    Loop Until lngFirst > lngLast
    
    If (lngLast - plngLeft) < (plngRight - lngFirst) Then
        If plngLeft < lngLast Then MedianThreeQuickSort1_2D_Asc pvarArray, iCol, plngLeft, lngLast
        If lngFirst < plngRight Then MedianThreeQuickSort1_2D_Asc pvarArray, iCol, lngFirst, plngRight
    Else
        If lngFirst < plngRight Then MedianThreeQuickSort1_2D_Asc pvarArray, iCol, lngFirst, plngRight
        If plngLeft < lngLast Then MedianThreeQuickSort1_2D_Asc pvarArray, iCol, plngLeft, lngLast
    End If
End Sub

Public Sub MedianThreeQuickSort1_2D_Desc(ByRef pvarArray As Variant, _
                                        ByVal iCol As Integer, _
                                            Optional ByVal plngLeft As Long, _
                                                Optional ByVal plngRight As Long)
'Grade A+
'NOTE: recursive routine, omit plngLeft & plngRight; they are used internally during recursion
    Dim j As Integer
    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim lngIndex As Long
    Dim varSwap As Variant
    Dim a As Long
    Dim b As Long
    Dim c As Long
    
    If plngRight = 0 Then
        plngLeft = LBound(pvarArray, 1)
        plngRight = UBound(pvarArray, 1)
    End If
    
    lngFirst = plngLeft
    lngLast = plngRight
    lngIndex = plngRight - plngLeft + 1
    a = Int(lngIndex * Rnd) + plngLeft
    b = Int(lngIndex * Rnd) + plngLeft
    c = Int(lngIndex * Rnd) + plngLeft
    If pvarArray(a, iCol) <= pvarArray(b, iCol) And pvarArray(b, iCol) <= pvarArray(c, iCol) Then
        lngIndex = b
    Else
        If pvarArray(b, iCol) <= pvarArray(a, iCol) And pvarArray(a, iCol) <= pvarArray(c, iCol) Then
            lngIndex = a
        Else
            lngIndex = c
        End If
    End If
    
    varMid = pvarArray(lngIndex, iCol)
    Do
        Do While pvarArray(lngFirst, iCol) > varMid And lngFirst < plngRight
            lngFirst = lngFirst + 1
        Loop
        
        Do While varMid > pvarArray(lngLast, iCol) And lngLast > plngLeft
            lngLast = lngLast - 1
        Loop
        
        If lngFirst <= lngLast Then
            For j = LBound(pvarArray, 2) To UBound(pvarArray, 2)
                varSwap = pvarArray(lngLast, j)
                pvarArray(lngLast, j) = pvarArray(lngFirst, j)
                pvarArray(lngFirst, j) = varSwap
            Next j
            
            lngFirst = lngFirst + 1
            lngLast = lngLast - 1
        End If
    Loop Until lngFirst > lngLast
    
    If (lngLast - plngLeft) < (plngRight - lngFirst) Then
        If plngLeft < lngLast Then MedianThreeQuickSort1_2D_Desc pvarArray, iCol, plngLeft, lngLast
        If lngFirst < plngRight Then MedianThreeQuickSort1_2D_Desc pvarArray, iCol, lngFirst, plngRight
    Else
        If lngFirst < plngRight Then MedianThreeQuickSort1_2D_Desc pvarArray, iCol, lngFirst, plngRight
        If plngLeft < lngLast Then MedianThreeQuickSort1_2D_Desc pvarArray, iCol, plngLeft, lngLast
    End If
End Sub
Ibo
  • 4,081
  • 6
  • 45
  • 65
  • After hours of searching on an approach, i used this today. Work Perfectly! AWESOME – user68650 Jul 05 '21 at 23:42
  • ibo - would be possible to modify the above procedure to sort on an optional second column of the array? – user68650 Jul 17 '21 at 18:33
  • Run the function twice, once for the first column and once for the second column if necessary. There is no need to make this more complicated. You can sort on multiple columns. Just run multiple times – Ibo Jul 18 '21 at 01:11
  • The two columns should be sorted dependent on each other. like sorting last names first, keeping that sor and then sorting first name a-z next. Executing the function twice would only sort on the last column sorted, in this case first name. – user68650 Jul 19 '21 at 19:40
  • As I said, you should sort the first name first and then sort the last name. That will give you the list sorted on the last name and within the sorted last name, the first names will be shown sorted too – Ibo Jul 19 '21 at 23:14
2

sometimes the most brainless answer is the best answer.

  1. add blank sheet
  2. download your array to that sheet
  3. add the sort fields
  4. apply the sort
  5. reupload the sheet data back to your array it will be the same dimension
  6. delete the sheet

tadaa. wont win you any programming prizes but it gets the job done fast.

swyx
  • 47
  • 1
1

I'm going to offer up a slight bit of different code to Steve's approach.

All valid points on efficiency, but to be frank.. when I was looking for a solution, I could have cared less about efficiency. Its VBA... I treat it like it deserves.

You want to sort a 2-d array. Plain simple dirty simple insert sort that will accept a variable size array and sort on a selected column.

Sub sort_2d_array(ByRef arrayin As Variant, colid As Integer)
'theWidth = LBound(arrayin, 2) - UBound(arrayin, 2)
For i = LBound(arrayin, 1) To UBound(arrayin, 1)
    searchVar = arrayin(i, colid)
    For ii = LBound(arrayin, 1) To UBound(arrayin, 1)
        compareVar = arrayin(ii, colid)
        If (CInt(searchVar) > CInt(compareVar)) Then
            For jj = LBound(arrayin, 2) To UBound(arrayin, 2)
                larger1 = arrayin(i, jj)
                smaller1 = arrayin(ii, jj)
                arrayin(i, jj) = smaller1
                arrayin(ii, jj) = larger1
            Next jj
            i = LBound(arrayin, 1)
            searchVar = arrayin(i, colid)
        End If
        Next ii
    Next i
End Sub
Community
  • 1
  • 1
giveemheller
  • 106
  • 8
0

For what it's worth (I can't show code at this point...let me see if I can edit it to post), I created an array of custom objects (so each of the properties come with whichever element its sorted by), populated a set of cells with each elements object properties of interest then used the excel sort function through vba to sort the column. Im sure theres probably a more efficient way of sorting it, rather than exporting it to cells, I just havent figured it out yet. This actually helped me a lot because when I needed to add a dimension, I just added a let and get property for the next dimension of the array.

Dan
  • 758
  • 6
  • 20
0

You could make a separate array with 2 columns. Column 1 would be what your sorting on and 2 is what row is in other array. Sort this array by column 1 (only switching the two columns when swap). Then you could use the 2 arrays to process data as needed. Huge arrays could give you memory problems though

0

When sorting a multiple column array, I don't rearrange the elements. Instead I pass through another array S with the same number of elements, and number the items 1,2,3,....

Then I use the values in S as the index of the column to be sorted, and when I need to swap elements, I swap the values in S.

On returning from the sort, I can rearrange the original array if I need to, based on the sort sequence in S. It is quite easy to adapt quick sort to allow for this.

dbb
  • 2,827
  • 18
  • 16
0

I have a similar array of Doubles to sort, so I've decided to write a native .dll. For testing, I was using 64-bit integers, so you can use it for sorting the last dimension of Long and ULong arrays.

    <DllImport("Arrayman.dll", EntryPoint:="SortLng")>
    Sub sort(ByRef Array1stItem As Long, ByRef Indices1stItem As Integer, ByVal nItemsToSort As Long)
    'Note: For sorting ULong integers, replace EntryPoint:="SortLng" with EntryPoint:="SortULng"
    End Sub

In your example, you'd call it as

Dim idx(5)
sort(myArray(3,0), idx(0), idx.count)

to sort items from (3, 0) to (3, 5). The lowest number is at myArray(3, idx(0)) and the highest at myArray(3, idx(5)).

ArrayMan.dll, more info and an example can be found on GitHub