PDA

View Full Version : Solved: Sort multi-dim array by one value?



paul_0722
07-13-2008, 01:35 AM
Cannot seem to make this work. I input a simple array, verify it is loaded and then output sorted array - but it is not sorting on first column as desired. I'm think I need to make the sort code a function instead of a sub? ...and somehow pass array values to it? Any help appreciated...

mdmackillop
07-13-2008, 02:03 AM
Something similar in this thread (http://www.vbaexpress.com/forum/showthread.php?t=12619).

xld
07-13-2008, 02:11 AM
The problem is caused by two things, first SortColumn is initialised at 0, but the data starts at column 1 (that is how you load it), then you have a 100,10 array but far fewer data items, so when you sort by column 1, then the blanks get sorted to the front.

xld
07-13-2008, 02:14 AM
This sorts it



Option Explicit

Private Sub cmdRESET_Click()
Range("A7:E17").Select
Selection.ClearContents
End Sub

Private Sub cmdSTART_Click()

''Sort a 2 dimensional array on 1 column
''This example sorts a two dimensional array named ArrayName on the first column
''(column 0). The sort is ascending. Reverse the > sign in the fourth row for a
''descending sort. bubble sort

Dim ArrayName As Variant
Dim SortColumn1 As Long
Dim Condition1 As Long
Dim i As Long
Dim j As Long
Dim y As Long
Dim t As Variant
Dim x As Long
Dim z As Long
Dim u As Long
Dim v As Long
Dim LastRow As Long
Dim LastCol As Long

'-------------------------------------------------------------------------------
'Read Array
'-------------------------------------------------------------------------------

LastRow = Range("A1").End(xlDown).Row
LastCol = Range("A1").End(xlToRight).Column
ReDim ArrayName(1 To LastRow, 1 To LastCol)
Sheets("input_array").Activate
z = 1
y = 1
Do
Do While Sheets("input_array").Cells(z, y).Value <> ""
If Sheets("input_array").Cells(z, y).Value <> "" Then
ArrayName(z, y) = Sheets("input_array").Cells(z, y).Value
y = y + 1
End If
Loop
z = z + 1
y = 1
If Cells(z, y).Value = "" Then Exit Do
Loop
'-------------------------------------------------------------------------------
'Confirm array before sort
'-------------------------------------------------------------------------------
For u = 1 To UBound(ArrayName, 1)
For v = 1 To UBound(ArrayName, 2)
Sheets("input_array").Cells(u + 6, v).Value = ArrayName(u, v)
Next v
Next u
'-------------------------------------------------------------------------------
'Sort
'-------------------------------------------------------------------------------
SortColumn1 = 1
For i = LBound(ArrayName, 1) To UBound(ArrayName, 1) - 1
For j = LBound(ArrayName, 1) To UBound(ArrayName, 1) - 1
Condition1 = ArrayName(j, SortColumn1) > ArrayName(j + 1, SortColumn1)
If Condition1 Then
For y = LBound(ArrayName, 2) To UBound(ArrayName, 2)
t = ArrayName(j, y)
ArrayName(j, y) = ArrayName(j + 1, y)
ArrayName(j + 1, y) = t
Next y
End If
Next
Next
'-------------------------------------------------------------------------------
'Confirm After Sort
'-------------------------------------------------------------------------------
For u = 1 To UBound(ArrayName, 1)
For v = 1 To UBound(ArrayName, 2)
Sheets("input_array").Cells(u + 12, v).Value = ArrayName(u, v)
Next v
Next u

Sheets("input_array").Range("G7").Value = "VERIFY"
Sheets("input_array").Range("G13").Value = "SORTED"

End Sub

paul_0722
07-13-2008, 03:26 AM
Thanks very much - working well now. I'll study your code and learn something new!! ...much appreciated

P