×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Sort multidimensional array

Sort multidimensional array

Sort multidimensional array

(OP)
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

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


 

RE: Sort multidimensional array

(OP)
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

RE: Sort multidimensional array

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.



 

RE: Sort multidimensional array

(OP)
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.
 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close