Array sorting

[jctsk]

I have an array in a custom type for my hockey game, for instance:

aPlayer(i).PlayerID
aPlayer(i).Firstname
aPlayer(i).Lastname
aPlayer(i).Weight

There's about 30 different attributes for each player as you can imagine. I'm trying to sort the list by Weight, but I'm having real trouble wrapping my head around it. I obviously need to keep the numbers in the same place (i.e. even if aPlayer(0).PlayerID was last on the list, he needs to stay aPlayer(0)). I guess I can create another array called aSort and fill this with the same information as aPlayer..but I'm not sure how to sort it properly.

Can I use a normal sorting routine? Because there's so many attributes, is it different? Can anyone post any sorting code that would be able to deal with this sort of array?

Sorry, it's really confusing me.

Thanks for your help in advance, sorry for the n00b question. Cheers

[MartinLiss]

You'll have to add more code for the 26 or so other fields in your UDT, but this is the basics.

Option Explicit
Private Type aPlayer
    PlayerID As String
    Firstname As String
    Lastname As String
    Weight As Double
End Type
Private TestData(4) As aPlayer
 
Private Sub Form_Load()
 
    Dim temp As aPlayer
    Dim bIsChange As Boolean
    Dim intIndex As Integer
 
    TestData(0).PlayerID = "a"
    TestData(0).Firstname = "Martin"
    TestData(0).Lastname = "Liss"
    TestData(0).Weight = 142
    
    TestData(1).PlayerID = "b"
    TestData(1).Firstname = "John"
    TestData(1).Lastname = "Weakling"
    TestData(1).Weight = 98
    
    TestData(2).PlayerID = "c"
    TestData(2).Firstname = "Tiny"
    TestData(2).Lastname = "Jones"
    TestData(2).Weight = 305
    
    TestData(3).PlayerID = "d"
    TestData(3).Firstname = "Steve"
    TestData(3).Lastname = "Stunning"
    TestData(3).Weight = 205
    
    TestData(4).PlayerID = "e"
    TestData(4).Firstname = "Grace"
    TestData(4).Lastname = "Slick"
    TestData(4).Weight = 180
    
    bIsChange = True
    Do Until bIsChange = False
        bIsChange = False
        For intIndex = 0 To UBound(TestData) - 1
            If TestData(intIndex).Weight > TestData(intIndex + 1).Weight Then
                bIsChange = True
                ' Swap the data
                temp.Firstname = TestData(intIndex).Firstname
                temp.Lastname = TestData(intIndex).Lastname
                temp.PlayerID = TestData(intIndex).PlayerID
                temp.Weight = TestData(intIndex).Weight
                
                TestData(intIndex).Firstname = TestData(intIndex + 1).Firstname
                TestData(intIndex).Lastname = TestData(intIndex + 1).Lastname
                TestData(intIndex).PlayerID = TestData(intIndex + 1).PlayerID
                TestData(intIndex).Weight = TestData(intIndex + 1).Weight
                
                TestData(intIndex + 1).Firstname = temp.Firstname
                TestData(intIndex + 1).Lastname = temp.Lastname
                TestData(intIndex + 1).PlayerID = temp.PlayerID
                TestData(intIndex + 1).Weight = temp.Weight
            End If
        Next
    Loop
    
    For intIndex = 0 To UBound(TestData)
        Debug.Print _
              TestData(intIndex).PlayerID & " " & _
              TestData(intIndex).Firstname & " " & _
              TestData(intIndex).Lastname & " " & _
              TestData(intIndex).Weight
    Next
    
End Sub

[jctsk]

Thanks very much! I'll give it a shot, see how it goes. The only thing I'm wondering about is the performance. This is the slowest type of sort, yes?

[MartinLiss]

I don't really know, but unless you have hundreds (or perhaps thousands) of records it won't matter.

[Merri]

The performance for the above, to my knowledge, gets cumulatively worse for each added item. Here is a solution which requires less calculating with big arrays (but uses more memory too):

Option Explicit
 
Private Type PlayerArray
    PlayerID As Long
    Firstname As String
    Lastname As String
    Weight As Byte
End Type
 
Dim aPlayer() As PlayerArray
Private Sub SortArray()
    Dim TempArray As New Collection, A As Long, B As Long, C As Long
    Dim SortedArray() As PlayerArray
    TempArray.Add 0
    For A = 1 To UBound(aPlayer)
        For B = 1 To TempArray.Count
            C = CLng(TempArray(B))
            If aPlayer(A).PlayerID < aPlayer(C).PlayerID Then TempArray.Add A, , B: Exit For
        Next B
        'check if we exited from the loop or not
        If B > TempArray.Count Then TempArray.Add A
    Next A
    ReDim SortedArray(UBound(aPlayer))
    For A = 1 To TempArray.Count
        B = CLng(TempArray(A))
        With SortedArray(A - 1)
            .PlayerID = aPlayer(B).PlayerID
            .Firstname = aPlayer(B).Firstname
            .Lastname = aPlayer(B).Lastname
            .Weight = aPlayer(B).Weight
        End With
    Next A
    For A = 0 To UBound(aPlayer)
        aPlayer(A).PlayerID = SortedArray(A).PlayerID
        aPlayer(A).Firstname = SortedArray(A).Firstname
        aPlayer(A).Lastname = SortedArray(A).Lastname
        aPlayer(A).Weight = SortedArray(A).Weight
    Next A
End Sub
Private Sub Form_Load()
    Dim A As Byte
    ReDim aPlayer(2)
    With aPlayer(0)
        .PlayerID = 1
        .Firstname = "Jack"
        .Lastname = "Humblerose"
        .Weight = 80
    End With
    With aPlayer(1)
        .PlayerID = 1
        .Firstname = "Jack"
        .Lastname = "Abrahamson"
        .Weight = 90
    End With
    With aPlayer(2)
        .PlayerID = 0
        .Firstname = "Jack"
        .Lastname = "Rogers"
        .Weight = 100
    End With
    SortArray
    For A = 0 To 2
        With aPlayer(A)
            Debug.Print "PlayerID:  " & .PlayerID
            Debug.Print "Firstname: " & .Firstname
            Debug.Print "Lastname:  " & .Lastname
            Debug.Print "Weight:    " & .Weight
        End With
    Next A
End Sub

You can get it faster if you can figure out how to use CopyMemory to copy complete data from SortedArray to aPlayer... I tried playing with it, but since I couldn't figure it out in my limited time (have to go to work soon), I didn't do it.

[ccoder]

Originally posted by jctsk
Thanks very much! I'll give it a shot, see how it goes. The only thing I'm wondering about is the performance. This is the slowest type of sort, yes?

FWIW, you can speed the bubble sort up by coding it in such a way that you only do 1 swap for each pass.

Dim arry(1 To 3, 1 To 2)
Dim inner    As Integer     ' inner loop index
Dim outer    As Integer     ' outer loop index
Dim lowval   As Integer     ' pointer to low value
Dim swapcol1 
Dim swapcol2
 
' some code to populate the array would go here
 
For outer = LBound(arry) To UBound(arry) - 1
    ' set lowval to current outer row
    lowval = outer                           
    For inner = outer + 1 To UBound(arry)
        ' look for lowest value in remaining rows
        If arry(inner, 1) < arry(lowval, 1) Then lowval = inner
    Next inner
    ' swap row data if a lower value was found
    If lowval <> outer Then
       swapcol1 = arry(outer, 1)
       swapcol2 = arry(outer, 2)
       arry(outer, 1) = arry(lowval, 1)
       arry(outer, 2) = arry(lowval, 2)
       arry(lowval, 1) = swapcol1
       arry(lowval, 2) = swapcol2
    End If
Next outer

[jctsk]

Thanks! I'll give them all a shot, see what will work the best for me.

Thanks so much for your help