Solved: sort multi dimensional array

[crush]

i have an array with multiple columns of data, and i'd like to be able to sort them based on the contents of the first two columns. has anyone done anything like this? any ideas to share? there seems to be lots of data regarding sorting on a single column, but not so much on multiple columns.

this is an idea of what my initial data might look like:

col1 col2 col3
56 22 xyz
22 30 zyz
56 30 zxz
22 30 zxz
10 18 zzz
22 18 zxx

this is how i would like to see it after sorting:

col1 col2 col3
56 30 zxz
56 22 xyz
22 30 zyz
22 30 zxz
22 18 zxx
10 18 zzz

i'd appreciate any sample codes...

kindest regards
Chris

[Paul_Hossler]

Work sheet range, or VBA ( ) array?

Paul

[Crocus Crow]

You need two separate sorts: firstly, sort all rows by the first column; then sort all rows by the second column where adjacent rows in the first column are equal. For both sorts, when a row swap is done all 3 columns must be swapped so that values in the same row stay together.

If you need further help, please post code for sorting a one dimensional array and it should be easy to modify it for multiple dimensions.

[crush]

Work sheet range, or VBA ( ) array?

Paul

i have the data in an array i'm not using a worksheet.

[crush]

You need two separate sorts: firstly, sort all rows by the first column; then sort all rows by the second column where adjacent rows in the first column are equal. For both sorts, when a row swap is done all 3 columns must be swapped so that values in the same row stay together.

If you need further help, please post code for sorting a one dimensional array and it should be easy to modify it for multiple dimensions.

i'm not sure if the attached will help, i've been searching around and found examples on this site. the attached allows one to specify which column to sort on, but it wont allow me to sort on the first two columns. there's a feature in excel that allows you to custom sort across multiple columns. I will need to do sort an array though, not values in an excel sheet.

[Paul_Hossler]

not very general purpose, but Redim( ) would be helpful if the amount of data varies

[VBA]
Sub test()
Dim a(1 To 6, 1 To 3) As Variant
Dim i As Long, j As Long
Dim v As Variant
Dim x As Long


'col1 col2 col3
' 56 22 xyz
' 22 30 zyz
' 56 30 zxz
' 22 30 zxz
' 10 18 zzz
' 22 18 zxx

a(1, 1) = 56
a(1, 2) = 22
a(1, 3) = "xyz"

a(2, 1) = 22
a(2, 2) = 30
a(2, 3) = "zyz"

a(3, 1) = 56
a(3, 2) = 30
a(3, 3) = "zxz"

a(4, 1) = 22
a(4, 2) = 30
a(4, 3) = "zyz"

a(5, 1) = 10
a(5, 2) = 18
a(5, 3) = "zzz"

a(6, 1) = 22
a(6, 2) = 18
a(6, 3) = "zxz"

'bubble sort col2
For i = LBound(a, 1) To UBound(a, 1) - 1
For j = i + 1 To UBound(a, 1)
If a(j, 2) > a(i, 2) Then
x = a(i, 1)
v = a(i, 3)
a(i, 1) = a(j, 1)
a(i, 3) = a(j, 3)
a(j, 1) = x
a(j, 3) = v
End If
Next j
Next i

'bubble sort col1
For i = LBound(a, 1) To UBound(a, 1) - 1
For j = i + 1 To UBound(a, 1)
If a(j, 1) > a(i, 1) Then
x = a(i, 1)
v = a(i, 3)
a(i, 1) = a(j, 1)
a(i, 3) = a(j, 3)
a(j, 1) = x
a(j, 3) = v
End If
Next j
Next i

For i = LBound(a, 1) To UBound(a, 1)
MsgBox a(i, 1) & " --- " & a(i, 2) & " --- " & a(i, 3)
Next i




Stop
End Sub
[/VBA]

Paul

[crush]

not very general purpose, but Redim( ) would be helpful if the amount of data varies

[VBA]
Sub test()
Dim a(1 To 6, 1 To 3) As Variant
Dim i As Long, j As Long
Dim v As Variant
Dim x As Long


'col1 col2 col3
' 56 22 xyz
' 22 30 zyz
' 56 30 zxz
' 22 30 zxz
' 10 18 zzz
' 22 18 zxx

a(1, 1) = 56
a(1, 2) = 22
a(1, 3) = "xyz"

a(2, 1) = 22
a(2, 2) = 30
a(2, 3) = "zyz"

a(3, 1) = 56
a(3, 2) = 30
a(3, 3) = "zxz"

a(4, 1) = 22
a(4, 2) = 30
a(4, 3) = "zyz"

a(5, 1) = 10
a(5, 2) = 18
a(5, 3) = "zzz"

a(6, 1) = 22
a(6, 2) = 18
a(6, 3) = "zxz"

'bubble sort col2
For i = LBound(a, 1) To UBound(a, 1) - 1
For j = i + 1 To UBound(a, 1)
If a(j, 2) > a(i, 2) Then
x = a(i, 1)
v = a(i, 3)
a(i, 1) = a(j, 1)
a(i, 3) = a(j, 3)
a(j, 1) = x
a(j, 3) = v
End If
Next j
Next i

'bubble sort col1
For i = LBound(a, 1) To UBound(a, 1) - 1
For j = i + 1 To UBound(a, 1)
If a(j, 1) > a(i, 1) Then
x = a(i, 1)
v = a(i, 3)
a(i, 1) = a(j, 1)
a(i, 3) = a(j, 3)
a(j, 1) = x
a(j, 3) = v
End If
Next j
Next i

For i = LBound(a, 1) To UBound(a, 1)
MsgBox a(i, 1) & " --- " & a(i, 2) & " --- " & a(i, 3)
Next i




Stop
End Sub
[/VBA]

Paul

thanks for helping paul, this is close... i think i get the idea of do one sort followed by the next column sort. i noticed that column 2 was not descending correctly though. the first item was 56-22, followed by 56-30. i think i might be able to run with the ideas you gave me though. and the array will be dynamic in length, but the columns should remain as three.

[Crocus Crow]

Try this:
[vba]Sub Sort_2D_Array()

Dim data(5, 2) As Variant
Dim v As Variant
Dim i As Integer, j As Integer
Dim r As Integer, c As Integer
Dim temp As Variant

'Create 2-dimensional array

v = Array(56, 22, "xyz", 22, 30, "zyz", 56, 30, "zxz", 22, 30, "zxz", 10, 18, "zzz", 22, 18, "zxx")
For i = 0 To UBound(v)
data(i \ 3, i Mod 3) = v(i)
Next

'Bubble sort column 0

For i = LBound(data) To UBound(data) - 1
For j = i + 1 To UBound(data)
If data(i, 0) < data(j, 0) Then
For c = LBound(data, 2) To UBound(data, 2)
temp = data(i, c)
data(i, c) = data(j, c)
data(j, c) = temp
Next
End If
Next
Next

'Bubble sort column 1, where adjacent rows in column 0 are equal

For i = LBound(data) To UBound(data) - 1
For j = i + 1 To UBound(data)
If data(i, 0) = data(j, 0) Then
If data(i, 1) < data(j, 1) Then
For c = LBound(data, 2) To UBound(data, 2)
temp = data(i, c)
data(i, c) = data(j, c)
data(j, c) = temp
Next
End If
End If
Next
Next

'Output sorted array

For r = LBound(data) To UBound(data)
For c = LBound(data, 2) To UBound(data, 2)
Debug.Print data(r, c);
Next
Debug.Print
Next

End Sub[/vba] This code will be reasonably fast for small arrays (say 100 rows), however for large arrays (1000s of rows) it will be far quicker to transfer the array to Excel cells and use the built-in Sort function. These steps can be done in 2 or 3 lines of code - search or play with the macro recorder.

[snb]

Assuming you are working in Excel.
Assuming your data in a table starting in cell A1
The sorted array in array sw

[vba]Sub snb()
sn = Cells(1).CurrentRegion

sq = Application.Index(sn, , 1)
st = sq

For j = 1 To UBound(sq)
st(j, 1) = sn(j, 1) * 10 ^ Len(Application.Max(Application.Index(sn, 2))) + sn(j, 2)
Next

For j = 1 To UBound(sq)
sq(j, 1) = Application.Match(Application.Large(st, j), st, 0)
Next

sw = Application.Index(sn, sq, Array(1, 2, 3))
End Sub[/vba]

If your data are in an array, not derived from a workbook the same principle applies.

[crush]

Crocus Crow, thanks for pitching in! I tried your code, and attempted to extend it a little using the data range from an excel worksheet.

but for some reason the second column of data does not sort correctly? if you run the attached you will see what i mean in the debug window.

the macro still runs pretty fast with these 38 entries. my data stream will likely always be less than 1000.

[crush]

SNB, thanks for the ideas, that does the sort perfectly and quickly!

however, I cannot use this since the calls to application.index, Application.Large, etc are not recognized in the application I'm using. I'm using vba in Solidworks. so calls specific to excel will not work, but general vba coding looping arrays etc work the same so I can use these.

[snb]

Although you could bind to Excel, this alternative uses no Excel functions:

[VBA]Sub snb()
sn = Cells(1).CurrentRegion
sp = sn

For j = 1 To UBound(sn)
If sn(j, 2) > x Then x = sn(j, 2)
Next

c01 = sn(1, 2) + sn(1, 1) * 10 ^ Len(x) & "_1|"
For j = 2 To UBound(sn)
y = sn(j, 2) + sn(j, 1) * 10 ^ Len(x)
c02 = c01

For jj = 1 To j
If y <= Val(c02) Then
c01 = Replace(c01, c02, y & "_" & j & "|" & c02)
Exit For
End If
c02 = Mid(c02, InStr(c02, "|") + 1)
Next

If jj > j Then c01 = c01 & y & "_" & j & "|"
Next

sr = Split(c01, "_")
For j = 1 To UBound(sn)
For jj = 1 To UBound(sp, 2)
sp(j, jj) = sn(Val(sr(UBound(sr) + 1 - j)), jj)
Next
Next

Cells(10, 1).Resize(UBound(sn), UBound(sn, 2)) = sp ' only a check
End Sub[/VBA]

[crush]

Although you could bind to Excel, this alternative uses no Excel functions:

Sub snb()
  sn = Cells(1).CurrentRegion
  sp = sn
     
  For j = 1 To UBound(sn)
    If sn(j, 2) > x Then x = sn(j, 2)
  Next
     
  c01 = sn(1, 2) + sn(1, 1) * 10 ^ Len(x) & "_1|"
  For j = 2 To UBound(sn)
    y = sn(j, 2) + sn(j, 1) * 10 ^ Len(x)
    c02 = c01
    
    For jj = 1 To j
      If y <= Val(c02) Then
        c01 = Replace(c01, c02, y & "_" & j & "|" & c02)
        Exit For
      End If
      c02 = Mid(c02, InStr(c02, "|") + 1)
    Next
    
    If jj > j Then c01 = c01 & y & "_" & j & "|"
  Next
    
  sr = Split(c01, "_")
  For j = 1 To UBound(sn)
    For jj = 1 To UBound(sp, 2)
      sp(j, jj) = sn(Val(sr(UBound(sr) + 1 - j)), jj)
    Next
  Next
        
  Cells(10, 1).Resize(UBound(sn), UBound(sn, 2)) = sp  ' only a check
End Sub

SNB, thanks you this is GREAT!.

I cannot say i fully understand all the code and loops, but it works like a charm! i added a last line to print out the results in the debug window, and sure enough everything is sorted perfectly.

i'll study the code in more detail to see if i can figure out how this is working!

note, i added your code to module1 in the attached sheet.

[Crocus Crow]

Crocus Crow, thanks for pitching in! I tried your code, and attempted to extend it a little using the data range from an excel worksheet.

but for some reason the second column of data does not sort correctly? if you run the attached you will see what i mean in the debug window.

My code was written for zero-based array indexing. An array loaded from a worksheet range is one-based (lower bound of both array dimensions is 1), therefore the code failed for this scenario.

Here is the revised code which works whether the array is zero- or one-based:

Sub Sort_2D_Array()
     
    Dim v As Variant
    Dim i As Integer, j As Integer, ci As Integer
    Dim r As Integer, c As Integer
    Dim temp As Variant
    'Dim data(5, 2) As Variant
    Dim data() As Variant
    
    'populate array
    data = Sheet1.Range("inputarray")

    'Create 2-dimensional array
     
    'v = Array(56, 22, "xyz", 22, 30, "zyz", 56, 30, "zxz", 22, 30, "zxz", 10, 18, "zzz", 22, 18, "zxx")
    'For i = 0 To UBound(v)
    '    data(i \ 3, i Mod 3) = v(i)
    'Next
     
    'Bubble sort 1st column
     
    ci = LBound(data, 2)                         '1st column index
    For i = LBound(data) To UBound(data) - 1
        For j = i + 1 To UBound(data)
            If data(i, ci) < data(j, ci) Then
                For c = LBound(data, 2) To UBound(data, 2)
                    temp = data(i, c)
                    data(i, c) = data(j, c)
                    data(j, c) = temp
                Next
            End If
        Next
    Next
     
    'Bubble sort 2nd column, where adjacent rows in 1st column are equal
     
    ci = LBound(data, 2) + 1                     '2nd column index
    For i = LBound(data) To UBound(data) - 1
        For j = i + 1 To UBound(data)
            If data(i, ci - 1) = data(j, ci - 1) Then       'compare adjacent rows in 1st column
                If data(i, ci) < data(j, ci) Then
                    For c = LBound(data, 2) To UBound(data, 2)
                        temp = data(i, c)
                        data(i, c) = data(j, c)
                        data(j, c) = temp
                    Next
                End If
            End If
        Next
    Next
     
    'Output sorted array
     
    For r = LBound(data) To UBound(data)
        For c = LBound(data, 2) To UBound(data, 2)
            Debug.Print data(r, c);
        Next
        Debug.Print
    Next
     
End Sub

[crush]

Crocus, this works perfectly now!

both SNB and Crocus, these are two great solutions and this problem is more than solved.

once again, this forum turns out to be the best of the best!

for anyone interested, please find the finished results attached in spreadsheet format. the bubble sort is quicker on a large data set. on a sort of 7300 rows, bubble sort took 6 secs on my laptop, snb approach took 41secs.

[crush]

how do you mark the thread as solved?

[Aussiebear]

Normally, you would go to the Thread Tools dropdown just above your initial post and select Mark Thread Solved. However I shall do this for you on this occasion.

[richfern]

Great solutions, just what I was looking for, thanks