**SORTED :) tx rj** Sorting 2D arrays on any column

[Jim Brown]

Gang,

I've just spent ages searching the site. There's a huge amount of stuff on sorting arrays, with attendant debate about which algo is best.

But as far as I can see, there's none that do a sort of a 2d array on any column. I'd like to see the user quizzed for "What field (=column) do you want to sort the records (=rows) on?" and Robert's your Dad's* brother.

Anyone?



* or Mum's

[nemaroller]

The code for the sorting is the hard part...

the easy part is adapting it to your needs...

I think it would be in your best interest to help everyone along ...
with information such as:

how is the array dimensioned? (I realize its a 2-d array, but what sizes)

[Jim Brown]

Not huge arrays. Probably about a couple of hundred records (maybe 1000 absolute max) of about 40 fields.

And while I think about it, it would be nice to do a sort on more than one column, eg perhaps first on UserName then on Date within.

BTW I'm not expecting anyone to sit and write this for me because I'll be very surprised if it doesn't exist somewhere already!

[nemaroller]

Basically it comes down to how you feed the sort algorithm...

so if you had

rec1: LastName FirstName MiddleName

you feed the LastName field into the Sort algorithm, and modifiy the algorithm to compare FirstName's only if the LastName comparison is indetermine (the names are equal). As you see below, if the first bolded line comparison cases to 0 (equal), the algorithm then checks the FirstNames (2nd bolded line), if those are equal, check the middlenames...

Do While incr > 0
        For i = incr To UBound(patientarray) Step 1
            j = i - incr
            Do While j >= 0
                [b]Select Case StrComp(patientarray(j).LName, patientarray(j + incr).LName, 1)[/b]
                
                Case 1:
                    
                    temp = patientarray(j)
                    patientarray(j) = patientarray(j + incr)
                    patientarray(j + incr) = temp
                    j = j - incr
                Case 0:
                    [b]Select Case StrComp(patientarray(j).FName, patientarray(j + incr).FName, 1)[/b]
                        Case 1:
                        
                        temp = patientarray(j)
                        patientarray(j) = patientarray(j + incr)
                        patientarray(j + incr) = temp
                        j = j - incr
                        
                        Case 0:[b]
                        Select Case StrComp(patientarray(j).MName, patientarray(j + incr).MName, 1)[/b]
                            Case 1:
                                temp = patientarray(j)
                                patientarray(j) = patientarray(j + incr)
                                patientarray(j + incr) = temp
                                j = j - incr
                            Case 0:
                                Select Case StrComp(patientarray(j).BDate, patientarray(j + incr).BDate, 0)
                                    Case 1:
                                          temp = patientarray(j)
                                          patientarray(j) = patientarray(j + incr)
                                          patientarray(j + incr) = temp
                                          j = j - incr
                                    Case 0:

Or, to sort on just any ONE field (meaning not considering the order of other fields), you simply feed that field to the algorithm...

[Jim Brown]

Thanks, I'll give that a try later today- I'm on my way out soon.

In the meantime, if anyone else has any suggestions, I'm keen to hear them!

Ciao.

[Jim Brown]

Nemaroller- you seem to have chopped off the bottom of your code. If you have a chance can you pop the rest of it in please...

[rjlohan]

For this code, add two textboxes (txtArrayOutput) (Index 0 for original array, index 1 for sorted array), you need 2 buttons, and a text box, labelled as the code suggests:

(I've also attached it as a .zip)

Option Explicit
 
'Data array
Private MyArray() As Variant
 
'Column identifiers
Private Const NUMBER = 0
Private Const X3_CHAR_CODE = 1
Private Const X10_CHAR_STRING = 2
 
'Enum for output textbox
Private Enum TextType
    TXT_ORIGINAL_ARRAY = 0
    TXT_SORTED_ARRAY = 1
End Enum
 
 
Private Sub btnCreateArray_Click()
    'Counter
    Dim i As Integer
    
    'Dim array
    ReDim MyArray(2, 5)
    
    'Fill array
    For i = 0 To (UBound(MyArray, 2) - 1)
        MyArray(NUMBER, i) = CInt(rnd * 100)
        MyArray(X3_CHAR_CODE, i) = Chr((rnd * 25) + 65) & Chr((rnd * 25) + 65) & Chr((rnd * 25) + 65)
        MyArray(X10_CHAR_STRING, i) = Chr((rnd * 94) + 31) & Chr((rnd * 94) + 31) & Chr((rnd * 94) + 31) & Chr((rnd * 94) + 31) & Chr((rnd * 94) + 31) & Chr((rnd * 94) + 31) & Chr((rnd * 94) + 31) & Chr((rnd * 94) + 31) & Chr((rnd * 94) + 31) & Chr((rnd * 94) + 31)
    Next
    
    'Display original array
    Call DisplayArray(TXT_ORIGINAL_ARRAY)
    
    'Enable sort buttons
    btnSortArray.Enabled = True
End Sub
 
 
'Uses bubble sort method
Private Sub btnSortArray_Click()
    'Counters
    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim allOk As Boolean
    
    'Temp array - should be same size as 1 record of MyArray
    ReDim tempN(UBound(MyArray, 1)) As Variant
    
    'Set sort column value
    Dim SC As Integer
    SC = CInt(txtColumn.Text)
    
    'Check sort column boundary
    If ((SC < 0) Or (SC > UBound(MyArray, 1))) Then
        MsgBox ("Invalid sort column entered.")
        Exit Sub
    End If
    
    'Sort array by first column
    For n = 0 To UBound(MyArray, 2)
        allOk = True
        For i = 0 To UBound(MyArray, 2) - 1
            If MyArray(SC, i) > MyArray(SC, i + 1) Then
                allOk = False
                'Get temp element
                For j = 0 To UBound(tempN)
                    tempN(j) = MyArray(j, i)
                    MyArray(j, i) = MyArray(j, i + 1)
                    MyArray(j, i + 1) = tempN(j)
                Next
            End If
        Next
        If allOk Then Exit For
    Next
    
    'Display sorted array
    Call DisplayArray(TXT_SORTED_ARRAY)
End Sub
 
 
Private Sub DisplayArray(TT As TextType)
    'Clear chosen textbox
    txtArrayOutput(TT).Text = ""
    
    'Display array on chosen textbox
    Dim i As Integer
    For i = TT To (UBound(MyArray, 2) - (1 - TT))
        txtArrayOutput(TT).Text = txtArrayOutput(TT).Text & _
            CStr(MyArray(NUMBER, i)) & " : " & _
            CStr(MyArray(X3_CHAR_CODE, i)) & " : " & _
            CStr(MyArray(X10_CHAR_STRING, i)) & vbNewLine
    Next
End Sub
 
 
Private Sub txtColumn_KeyPress(KeyAscii As Integer)
    'Disallow non-numeric entries
    If ((KeyAscii < vbKey0) Or (KeyAscii > vbKey9)) Then
        If (KeyAscii <> vbKeyBack) Then KeyAscii = 0
    End If
End Sub

I know it looks long, but there's auxilliary crap in there (creating an array, displaying the results, etc). Also, I've implemented this on a variant array, using a bubble sort method I pinched from Jamie. The sort method is arbitrary really, this one just didn't involve much code.

I'd have gone further and sorted on multiple columns, but the logic behind that escapes me at the moment. Anyway, the architecture is there, you're a smart boy, you can work it out.

To implement this fully in your solution, I suggest creating a 2nd 2D array to store a pair of COLUMN_NAME, COLUMN_INDEX for a better UI. Hopefully you can slip all that in there.

[Jim Brown]

Thanks RJ, I'll give that a bash.

[Evil_Giraffe]

If you use this function to compare the rows, then you should be able to sort on an arbitrary number/order of columns. I haven't tested it however.

Private Function CompareElements(Element1() As Variant, Element2() As Variant, SortColumns() As Integer) As Integer
  ' Compares the two arrays Element1 and Element2 on their elements in the order defined by SortColumns
  ' Returns 0 if they are equivalent
  ' Returns 1 if Element1 occurs *before* Element2
  ' Returns 2 if Element1 occurs *after* Element2
  ' If the column index given in SortColumns is out of bounds for Element1 or Element2, act as follows:
  '   If it is out of bounds for both, return 0 (both equivalent)
  '   If it is out of boubds for just one, return as though the one that is in bounds occurs *after* the other
  ' A 'Null' entry counts as *before* anything else
  
  Dim Compared As Boolean
  Dim i As Integer
  Dim LowEl1 As Integer, UpEl1 As Integer, LowEl2 As Integer, UpEl2 As Integer
  Dim CurrSortIndex As Integer
  
  CompareElements = 0
  Compared = False
  i = LBound(SortColumns)
  LowEl1 = LBound(Element1)
  UpEl1 = UBound(Element1)
  LowEl2 = LBound(Element2)
  UpEl2 = UBound(Element2)
  
  Do While Not Compared And i <= UBound(SortColumns)
    CurrSortIndex = SortColumns(i)
    If CurrSortIndex < LowEl1 Or CurrSortIndex > UpEl1 Then
      ' Element1 out of bounds, check Element2
      If CurrSortIndex < LowEl2 Or CurrSortIndex > UpEl2 Then
        ' Element2 out of bounds as well, return 0
        CompareElements = 0
        Compared = True
        
      Else
        ' Only Element1 out of bounds, return 1
        CompareElements = 1
        Compared = True
        
      End If
    ElseIf CurrSortIndex < LowEl2 Or CurrSortIndex > UpEl2 Then
      ' Element2 out of bounds but Element1 isn't, return 2
      CompareElements = 2
      Compared = True
      
    Else
      ' Just compare them
      If Element1 < Element2 Then
        CompareElements = 1
        Compared = True
      ElseIf Element1 > Element2 Then
        CompareElements = 2
        Compared = True
      ElseIf Element1 = Element2 Then
        ' Skip to the next column
      Else
        ' One or other is null.
        If Element1 Is Null Then
          If Element2 Is Null Then
            ' Both null, continue checking with next column
          Else
            ' Element1 Null, Element2 not Null
            CompareElements = 1
            Compared = True
          End If
        ElseIf Element2 Is Null Then
          ' Element1 not Null, Element2 Null
          CompareElements = 2
          Compared = True
        Else
         ' Any cases I haven't considered should be equal
        End If
      End If
    End If
  Loop
  
End Function