PDA

View Full Version : Solved: sort multi dimensional array



crush
04-24-2012, 11:48 AM
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
04-24-2012, 04:46 PM
Work sheet range, or VBA ( ) array?

Paul

Crocus Crow
04-24-2012, 04:56 PM
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
04-24-2012, 05:45 PM
Work sheet range, or VBA ( ) array?

Paul

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

crush
04-24-2012, 06:18 PM
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
04-24-2012, 06:27 PM
not very general purpose, but Redim( ) would be helpful if the amount of data varies


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


Paul

crush
04-24-2012, 06:46 PM
not very general purpose, but Redim( ) would be helpful if the amount of data varies


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


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
04-25-2012, 04:41 AM
Try this:
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 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
04-25-2012, 05:36 AM
Assuming you are working in Excel.
Assuming your data in a table starting in cell A1
The sorted array in array sw

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

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

crush
04-25-2012, 08:31 AM
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
04-25-2012, 08:51 AM
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
04-25-2012, 11:10 AM
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

crush
04-25-2012, 12:21 PM
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
04-26-2012, 07:38 AM
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
04-26-2012, 08:50 AM
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
04-26-2012, 09:03 AM
how do you mark the thread as solved?

Aussiebear
04-29-2012, 12:13 AM
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
01-26-2015, 08:39 AM
Great solutions, just what I was looking for, thanks