Sort multidimensional array

[cluM09]

Hello,

I have a multidimensional array that I need to sort based
on the column of the array.

I found a function that can sort the multidimensional array
based on the column, but it only works with the MD array
that has the format of array(col, row). I want to sort the
multidimensional array based on the column with the array
format of array(row, col) instead.

I modified the function to be able to sort the array with the
format of array(row, col), but it can only output up to
three records after sorting.

Below is my test code and the function. I need help with the
function so that it can handle the MD array with more than
three records.

Any help or direction will be greatly appreciated.

Thank you.

-------------------------------------------------------------

Dim myArray(4,2)
'myArray(row, col)

myArray(0, 0) = "Toyota"
myArray(0, 1) = "White"
myArray(0, 2) = "22,000.00"
myArray(1, 0) = "Ford"
myArray(1, 1) = "Blue"
myArray(1, 2) = "12,500.00"
myArray(2, 0) = "Porsche"
myArray(2, 1) = "Red"
myArray(2, 2) = "50,000.00"
myArray(3, 0) = "BMW"
myArray(3, 1) = "Yellow"
myArray(3, 2) = "26,000.00"
myArray(4, 0) = "Honda"
myArray(4, 1) = "Silver"
myArray(4, 2) = "25,000.00"

Wscript.Echo "Unsorted array"

j = 0
Wscript.Echo "No." & " | " & "Brand" & " | " & "Color" & " | " & "Price"
For i = 0 To UBound(myArray)
j = j + 1 ' col, row col, row col, row
Wscript.Echo j & " | " & myArray(i,0) & " | " & myArray(i,1) & " | " & myArray(i,2)
Next

Wscript.StdOut.WriteBlankLines(2)

Wscript.Echo "Sorted array"

sortedArray = arraysort(myArray, 0, "a")

j = 0
Wscript.Echo "No." & " | " & "Brand" & " | " & "Color" & " | " & "Price"
For i = 0 To UBound(sortedArray, 2)
j = j + 1 ' col, row col, row col, row
Wscript.Echo j & " | " & sortedArray(i,0) & " | " & sortedArray(i,1) & " | " & sortedArray(i,2)
Next

Function arraysort(values(),intSortCol,strDirection)
Dim i, j, value, value_j, min, max, temp, datatype
Dim intComp, intA, intCheckIndex

min = LBound(values)
max = UBound(values)

' check to see what direction you want to sort.
If Lcase(strDirection) = "a" Then
intComp = -1
Else
intComp = 1
End If

If intSortCol < 0 or intSortCol > UBound(values,2) Then
arraysort = values
Exit Function
End If

'find the first item which has valid data in it to sort
intCheckIndex = min
While Len(Trim(values(intCheckIndex,intSortCol))) = 0 And _
intCheckIndex < UBound(values,2)
intCheckIndex = intCheckIndex + 1
Wend

If isDate(Trim(values(intCheckIndex,intSortCol))) Then
datatype = 1
Else
If isNumeric(Trim(values(intCheckIndex,intSortCol))) Then
datatype = 2
Else
datatype = 0
End If
End If

For i = min To max - 1
value = values(i,intSortCol)
value_j = i
For j = i + 1 To max
Select Case datatype
Case 0
'See if values(j) is smaller. Works with strings now.
If strComp(values(j,intSortCol),value,vbTextCompare) = intComp Then
'Save the new smallest value.
value = values(j,intSortCol)
value_j = j
End If
Case 1
If intComp = -1 Then
If DateDiff("s",values(j,intSortCol),value) > 0 Then
'Save the new smallest value.
value = values(j,intSortCol)
value_j = j
End If
Else
If DateDiff("s",values(j,intSortCol),value) < 0 Then
'Save the new smallest value.
value = values(j,intSortCol)
value_j = j
End If
End If
Case 2
If intComp = -1 Then
If Cdbl(values(j,intSortCol)) < Cdbl(value) Then
' Save the new smallest value.
value = values(j,intSortCol)
value_j = j
End If
Else
If Cdbl(values(j,intSortCol)) > Cdbl(value) Then
'Save the new smallest value.
value = values(j,intSortCol)
value_j = j
End If
End If
End Select
Next 'j
If value_j <> i Then
'Swap items i and value_j.
For intA = 0 To UBound(values,2)
temp = values(value_j,intA)
values(value_j,intA) = values(i,intA)
values(i,intA) = temp
Next 'intA
End If
Next 'i
arraysort = values
End Function

---------------------------------------------------------------------------------------

 

[cluM09]

Sorry, the posted test code should be stated "row, col'
and not "col, row" as shown below:

Wscript.Echo "Unsorted array"

j = 0
Wscript.Echo "No." & " | " & "Brand" & " | " & "Color" & " | " & "Price"
For i = 0 To UBound(myArray)
j = j + 1 ' row, col row, col row, col
Wscript.Echo j & " | " & myArray(i,0) & " | " & myArray(i,1) & " | " & myArray(i,2)
Next

Wscript.StdOut.WriteBlankLines(2)

Wscript.Echo "Sorted array"

sortedArray = arraysort(myArray, 2, "a")

j = 0
Wscript.Echo "No." & " | " & "Brand" & " | " & "Color" & " | " & "Price"
For i = 0 To UBound(sortedArray, 2)
j = j + 1 ' row, col row, col row, col
Wscript.Echo j & " | " & sortedArray(i,0) & " | " & sortedArray(i,1) & " | " & sortedArray(i,2)
Next

 

[DTracy]

On your display of sorted array the limit of the loop is set to UBound(sortedArray, 2). Set that to UBound(sortedArray) and it will work.

David.

 

[PHV]

Have a look here:
faq329-3362

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[cluM09]

Dtracy,

Thank you for the help. It allows me to loop through the entire array after I changed to
UBound(sortedArray).

However, the sortarray function works for the array that I tested, but not
when I create the multidimensional array from a file with more columns. The sort mechanism
does not work properly for a string value that has a coma within the string although I used
tab as my delimiter when I created my text file for the array and read the data to a
two dimensional array.

I agree with PHV that the disconnected recordset method works better although I had
to split my record to obtain the data in each field during sorting when I want to select
a certain field to sort, which will probably take longer.

I wished I could use the sortarray function so that I don't have the split the data
in each field during sorting.