Sorting a multidimensional array in VBA

Question

I defined the following Dim myArray(10,5) as Long array and would like to sort it. What would be the best way to do this?

I will need to process a lot of data, for example, a 1000 x 5 matrix. It contains mainly numbers and dates and needs to sort it according to a specific column

Answer 1

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

Notes:

You will notice that I am doing a much more secure encoding than you will see in most code examples on the Internet: this is an Excel forum, and you must anticipate zeros and empty values ​​... Or nested arrays and objects in arrays if your source array comes from (say) a third-party source of market data in real time.

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

Your challenge will be:

  QuickSort MyArray ,, 2 

... Passing '2' as a column to sort and exclude optional parameters that pass the upper and lower borders of the search domain,

[EDITED] - Fixed an odd formatting failure in <code> tags, which seem to have problems with hyperlinks in code comments.

The clipped hyperlink was an array variant detection 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 version of one column:

 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 BubbleSort for this kind of thing, but it slows down a lot after the array exceeds 1024 rows. I will add the code below for your reference: note that I did not provide the source code for ArrayDimensions, so it will not be compiled for you unless you reorganize it, or split it into versions of "Array" and "vector".

 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 been a little late to solve your problem when you need it, but other people will pick it up when they get Google answers for similar problems.

Answer 2

The tough part is that VBA does not provide an easy way to exchange strings in a 2D array. For each swap, you will need to sort through 5 elements and change each of them, which will be very inefficient.

I assume that the 2D array is really not the one you should use anyway. Does each column have a specific meaning? If so, should you use an array of a user-defined type or an array of objects that are instances of a class module? Even if 5 columns do not have specific values, you can still do it, but define a UDT or class module to have only one element, which is a 5-element array.

For the sorting algorithm itself, I would use a simple ol 'Insertion Sort. The 1000 elements are actually not that big, and you probably won’t notice the difference between insertion sorting and quick sorting if we make sure that each exchange is not too slow. If you do , use Quick Sort, you will need to carefully code it to make sure that you don’t have free space on the stack, which can be done, but it’s difficult, and Quick Sort is harder enough.

So, assuming you are using an UDT array, and assuming that the UDT contains options named Field1 through Field5 and assuming that we want to sort by 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 

Answer 3

sometimes the most brainless answer is the best answer.

• add blank sheet
• upload an array to this sheet.
• add sort fields
• apply sorting
• reload the sheet data back into your array, it will be the same size
• delete sheet

tadaa. he won’t win any programming calls, but he will get the job done quickly.

Answer 4

I am going to offer slightly different code for Steve's approach.

All valid points of effectiveness, but honestly, when I was looking for a solution, I could care about efficiency. His VBA ... I treat him the way he deserves.

You want to sort a 2 dimensional array. The usual plain dirty simple insertion sort, which will take an array of variable sizes and sort by the 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 

Answer 5

What is it worth (I cannot show the code at the moment ... let me see if I can edit it for publication), I created an array of user objects (so that each of the properties has an element sorted by), filled a set of cells with the interests of each object objects, and then used the excel sort function via vba to sort the column. I am sure that perhaps a more efficient way to sort it, rather than export it to cells, I just did not understand this. This helped me a lot because when I needed to add a dimension, I just added the let and get property for the next dimension of the array.

Answer 6

It seems to me that the QuickSort code above cannot handle spaces. I have an array with numbers and spaces. When I sort this array, records with spaces are mixed between records with numbers. It took me a long time to find out, so it's probably good to keep in mind when you use this code.

better marseille