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.

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.

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

Powered by vBulletin® Version 4.2.5 Copyright © 2020 vBulletin Solutions Inc. All rights reserved.