[RESOLVED] VS2010 MultiDimesional Array Sort based on several criteria

Hi to all

I am having trouble trying to sort a 2-dimensional string array [10,5] by column order 1,2 and 3 (similar to Excel, which I want to avoid) or any other combination. I managed to get the result I need but in a very crude way. Could someone point a more efficient way please ?
Thanks

Code:

---


Public Class Form1

    ' try to sort a multi-dimensional array based on one or more criteria.
    ' here will use 3 criteria, DATE, BUS ID and DEP TIME.

    Dim maxFields = 5

    Dim arr(10, maxFields) As String
    Dim sortedArr(10, maxFields) As String  ' to accept original arr()
    Dim tempo(10, maxFields) As String      ' to use for temporary swaps

    Dim maxRecs As Integer
    Dim s As String

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        SortingItNow()
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load

        ' fields
        ' 1 = date
        ' 2 = bus
        ' 3 = dep time(s)
        ' 4 = rec nbr
        ' 5 = driver code

        arr(1, 1) = "05-Apr-2015" : arr(1, 2) = "bus-1" : arr(1, 3) = "10:45" : arr(1, 4) = "1" : arr(1, 5) = "TSA"
        arr(2, 1) = "05-Apr-2015" : arr(2, 2) = "bus-2" : arr(2, 3) = "10:30" : arr(2, 4) = "2" : arr(2, 5) = "ZIF"
        arr(3, 1) = "05-Apr-2015" : arr(3, 2) = "bus-1" : arr(3, 3) = "08:00" : arr(3, 4) = "3" : arr(3, 5) = "TSA"
        arr(4, 1) = "02-Apr-2015" : arr(4, 2) = "bus-1" : arr(4, 3) = "08:20" : arr(4, 4) = "4" : arr(4, 5) = "LIN"

        maxRecs = 4

        RichTextBox1.Text = "start"
        RichTextBox1.Text = RichTextBox1.Text & Chr(10)
        RichTextBox1.Text = RichTextBox1.Text & arr(1, 1) & " " & arr(1, 2) & " " & arr(1, 3) & " " & arr(1, 4) & " " & arr(1, 5) & " " & Chr(10)
        RichTextBox1.Text = RichTextBox1.Text & arr(2, 1) & " " & arr(2, 2) & " " & arr(2, 3) & " " & arr(2, 4) & " " & arr(2, 5) & " " & Chr(10)
        RichTextBox1.Text = RichTextBox1.Text & arr(3, 1) & " " & arr(3, 2) & " " & arr(3, 3) & " " & arr(3, 4) & " " & arr(3, 5) & " " & Chr(10)
        RichTextBox1.Text = RichTextBox1.Text & arr(4, 1) & " " & arr(4, 2) & " " & arr(4, 3) & " " & arr(4, 4) & " " & arr(4, 5) & " " & Chr(10)
        RichTextBox1.Text = RichTextBox1.Text & "end"


    End Sub

    Private Sub SortingItNow()

        Dim sortCond, StartRec, EndRec As Integer
        Dim totItems, sortField As Integer
        Dim s
        s = ""
        totItems = maxRecs

        For n = 1 To maxRecs
            For j = 1 To maxFields
                sortedArr(n, j) = arr(n, j)
                tempo(n, j) = ""
            Next
        Next

        '================================
        ' sort for first condition
        '================================

        sortCond = 1  ' date - ORIGINAL SORT
        StartRec = 1
        EndRec = maxRecs
        SortRecs(sortCond, StartRec, EndRec)
        '
        DisplayA()

        '----------------------------------------------------------------------------

        Dim remaining, oldLine, nextLine, tot As Short
        remaining = maxRecs
        nextLine = 0
        oldLine = 0
        tot = 0

        sortField = 1  ' date
        For n = 1 To maxRecs
            tot = tot + 1
            For j = 1 To maxFields : tempo(n, j) = sortedArr(n, j) : Next j
            ' if DATE differs
            If n > 1 And sortedArr(n, sortField) <> sortedArr(n - 1, sortField) Then
                remaining = remaining - 1      ' remaining items to sort ALWAYS < maxRecs
                nextLine = n                    ' remember current position - VERY VOLATILE ?!
                tot = tot - 1                  ' total elements for sorting till now !
                oldLine = n
                Exit For
            End If
        Next

        ' tot + remaining MUST BE EQUAL TO =  maxRecs

        If tot > 1 Then
            'sort elements till now
            sortCond = 2  ' bus id
            StartRec = 1
            EndRec = tot
            SortRecs(sortCond, StartRec, EndRec)
        Else
            ' seems none or only 1 item found so keep it...  ???!!!

        End If

        For n = nextLine To maxRecs
            tot = tot + 1                      ' continue count from last value...
            For j = 1 To maxFields : tempo(n, j) = sortedArr(n, j) : Next j
            ' if DATE differs
            If n > nextLine And sortedArr(n, sortField) <> sortedArr(n - 1, sortField) Then
                remaining = remaining - 1      ' remaining items to sort ALWAYS < maxRecs
                nextLine = n                    ' remember current position - VERY VOLATILE ?!
                tot = tot - 1                  ' total elements for sorting till now !
                Exit For
            Else

            End If
        Next

        '================================
        ' sort for second condition
        '================================

        If tot > 1 Then
            'sort elements till now
            sortCond = 2  ' bus id
            StartRec = nextLine
            EndRec = maxRecs
            SortRecs(sortCond, StartRec, EndRec)
        Else
            ' seems none or only 1 item found so keep it
        End If
        '
        DisplayB()

        '================================
        ' now HOLD TWO CONDITIONS and sort for third !!
        '================================

        Dim firstFound, lastFound
        firstFound = 0
        lastFound = 0

        ' here record 1 and 4 are preserved, 2 and 3 sorted per dep time.
        For n = nextLine To maxRecs
            If n > nextLine And sortedArr(n, 1) = sortedArr(n - 1, 1) And sortedArr(n, 2) = sortedArr(n - 1, 2) Then
                ' Mark first / last record lines for sorting
                If firstFound = 0 Then firstFound = n - 1
                lastFound = n
            End If
        Next

        sortcond = 3
        startrec = firstFound
        endrec = lastFound
        SortRecs(sortCond, startRec, EndRec)
        '
        DisplayC()

    End Sub

    Sub SortRecs(sortCond, StartRec, EndRec)
        ' sorting routine
        Dim sortField As Short
        sortField = sortCond
        For i = startRec To EndRec
            For j = startRec To (EndRec - 1)
                If sortedArr(j, sortField) > sortedArr((j + 1), sortField) Then
                    For w = 1 To maxFields
                        tempo(j, w) = sortedArr(j, w)
                    Next
                    For w = 1 To maxFields
                        sortedArr(j, w) = sortedArr((j + 1), w)
                    Next
                    For w = 1 To maxFields
                        sortedArr((j + 1), w) = tempo(j, w)
                    Next
                End If
            Next j
        Next i
    End Sub

    Sub DisplayA()
        s = ""
        RichTextBox2.Text = "start"
        For n = 1 To maxRecs
            For j = 1 To maxFields
                s = s & sortedArr(n, j) & " "
            Next
            RichTextBox2.Text = RichTextBox2.Text & Chr(10) & s
            s = ""
        Next
        RichTextBox2.Text = RichTextBox2.Text & Chr(10) & "end"
    End Sub

    Sub DisplayB()
        s = ""
        RichTextBox3.Text = "start"
        For n = 1 To maxRecs
            For j = 1 To maxFields
                s = s & sortedArr(n, j) & " "
            Next
            RichTextBox3.Text = RichTextBox3.Text & Chr(10) & s
            s = ""
        Next
        RichTextBox3.Text = RichTextBox3.Text & Chr(10) & "end"
    End Sub

    Sub DisplayC()
        s = ""
        RichTextBox4.Text = "start"
        For n = 1 To maxRecs
            For j = 1 To maxFields
                s = s & sortedArr(n, j) & " "
            Next
            RichTextBox4.Text = RichTextBox4.Text & Chr(10) & s
            s = ""
        Next
        RichTextBox4.Text = RichTextBox4.Text & Chr(10) & "end"
    End Sub

End Class

---

Attachment 125725

try this:

Code:

---

Public Class Form1

    Dim maxFields As Integer = 5
    Dim arr(10, maxFields) As String
    Dim sortedArr(,) As String

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '!!!remember arrays are zero based
        arr(0, 1) = "02-Apr-2016" : arr(0, 2) = "bus-4" : arr(0, 3) = "00:20" : arr(0, 4) = "2" : arr(0, 5) = "LIN"
        arr(1, 1) = "05-Apr-2015" : arr(1, 2) = "bus-1" : arr(1, 3) = "10:45" : arr(1, 4) = "4" : arr(1, 5) = "TSA"
        arr(2, 1) = "05-Apr-2015" : arr(2, 2) = "bus-2" : arr(2, 3) = "10:30" : arr(2, 4) = "3" : arr(2, 5) = "ZIF"
        arr(3, 1) = "05-Apr-2015" : arr(3, 2) = "bus-1" : arr(3, 3) = "08:00" : arr(3, 4) = "2" : arr(3, 5) = "TSA"
        arr(4, 1) = "02-Apr-2015" : arr(4, 2) = "bus-1" : arr(4, 3) = "08:20" : arr(4, 4) = "1" : arr(4, 5) = "LIN"
        arr(5, 1) = "02-Apr-2015" : arr(5, 2) = "bus-3" : arr(5, 3) = "10:45" : arr(5, 4) = "1" : arr(5, 5) = "TSA"
        arr(6, 1) = "02-Apr-2015" : arr(6, 2) = "bus-6" : arr(6, 3) = "10:30" : arr(6, 4) = "2" : arr(6, 5) = "ZIF"
        arr(7, 1) = "12-Apr-2015" : arr(7, 2) = "bus-1" : arr(7, 3) = "08:00" : arr(7, 4) = "3" : arr(7, 5) = "TSA"
        arr(8, 1) = "02-Apr-2016" : arr(8, 2) = "bus-1" : arr(8, 3) = "08:20" : arr(8, 4) = "4" : arr(8, 5) = "LIN"
        arr(9, 1) = "02-Apr-2015" : arr(9, 2) = "bus-1" : arr(9, 3) = "08:20" : arr(9, 4) = "3" : arr(9, 5) = "LIN"
        arr(10, 1) = "02-Apr-2015" : arr(10, 2) = "bus-4" : arr(10, 3) = "08:20" : arr(10, 4) = "2" : arr(10, 5) = "LIN"

        sortDynamically(New Integer() {1}, RichTextBox1)
        sortDynamically(New Integer() {1, 2}, RichTextBox2)
        sortDynamically(New Integer() {1, 2, 3}, RichTextBox3)

    End Sub

    Private Sub sortDynamically(ByVal sortBy() As Integer, ByVal outputTo As RichTextBox)
        sortedArr = DirectCast(arr.Clone, String(,))

        For outer As Integer = 0 To sortedArr.GetUpperBound(0)
            For inner As Integer = outer To 1 Step -1
                For x As Integer = 0 To sortBy.GetUpperBound(0)
                    Dim compareValue As Integer = 0
                    Select Case sortBy(x)
                        Case 1 'date
                            compareValue = CDate(sortedArr(inner, sortBy(x))).CompareTo(CDate(sortedArr(inner - 1, sortBy(x))))
                        Case 2 'integer
                            compareValue = CInt(sortedArr(inner, sortBy(x)).Replace("bus-", "")).CompareTo(CInt(sortedArr(inner - 1, sortBy(x)).Replace("bus-", "")))
                        Case 3 'timespan
                            compareValue = TimeSpan.Parse(sortedArr(inner, sortBy(x))).CompareTo(TimeSpan.Parse(sortedArr(inner - 1, sortBy(x))))
                        Case 4 'integer
                            compareValue = CInt(sortedArr(inner, sortBy(x))).CompareTo(CInt(sortedArr(inner - 1, sortBy(x))))
                        Case 5 'string
                            compareValue = sortedArr(inner, sortBy(x)).CompareTo(sortedArr(inner - 1, sortBy(x)))
                    End Select
                    If compareValue = 0 Then
                        Continue For
                    ElseIf compareValue = -1 Then
                        Dim temp() As String = Enumerable.Range(0, sortedArr.GetLength(1)).Select(Function(i) sortedArr(inner, i)).ToArray
                        For i As Integer = 0 To temp.GetUpperBound(0)
                            sortedArr(inner, i) = sortedArr(inner - 1, i)
                            sortedArr(inner - 1, i) = temp(i)
                        Next
                    End If
                    Exit For
                Next
            Next
        Next

        displayResults(outputTo)
    End Sub

    Private Sub displayResults(ByVal outputTo As RichTextBox)
        Dim s As String = ""
        outputTo.Text = "start"
        For n = 0 To 10
            For j = 1 To maxFields
                s &= sortedArr(n, j) & " "
            Next
            outputTo.Text &= Chr(10) & s
            s = ""
        Next
        outputTo.Text &= Chr(10) & "end"
    End Sub

End Class

---

.paul.

Thanks a lot mate, it works fine :) !

Final code below.

Code:

---

' try to sort a multi-dimensional array based on one or more criteria.
' here will use 3 criteria, DATE, BUS ID and DEP TIME.

' fields
' 1 = date
' 2 = bus id
' 3 = dep time(s)
' 4 = rec nbr
' 5 = driver id

Public Class Form1

    ' Essential code by .paul. 14 Apr 2015 - with THANKS !
    ' http://www.vbforums.com/showthread.php?793611-VS2010-MultiDimesional-Array-Sort-based-on-several-criteria
    '

    Dim maxRec As Integer = 6
    Dim maxFields As Integer = 5

    Dim arr(maxRec, maxFields) As String
    Dim sortedArr(,) As String

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Me.Text = "MultiDimesional-Array-Sort-based-on-several-criteria"

        '!!!remember arrays are zero based
        ' Stop using array element comparisons ( n = n-1 or n <> n-1 ) - messy indices -  as more efficient ways exist !!!

        arr(0, 1) = "02-Apr-2016" : arr(0, 2) = "bus-4" : arr(0, 3) = "00:20" : arr(0, 4) = "1" : arr(0, 5) = "LIN"
        arr(1, 1) = "05-Apr-2015" : arr(1, 2) = "bus-1" : arr(1, 3) = "10:45" : arr(1, 4) = "2" : arr(1, 5) = "TSA"
        arr(2, 1) = "05-Apr-2015" : arr(2, 2) = "bus-2" : arr(2, 3) = "10:30" : arr(2, 4) = "3" : arr(2, 5) = "ZIF"
        arr(3, 1) = "05-Apr-2015" : arr(3, 2) = "bus-1" : arr(3, 3) = "08:00" : arr(3, 4) = "4" : arr(3, 5) = "TSA"
        arr(4, 1) = "02-Apr-2015" : arr(4, 2) = "bus-1" : arr(4, 3) = "08:20" : arr(4, 4) = "5" : arr(4, 5) = "LIN"
        arr(5, 1) = "02-Apr-2015" : arr(5, 2) = "bus-3" : arr(5, 3) = "10:45" : arr(5, 4) = "6" : arr(5, 5) = "TSA"
        arr(6, 1) = "02-Apr-2015" : arr(6, 2) = "bus-5" : arr(6, 3) = "10:30" : arr(6, 4) = "7" : arr(6, 5) = "ZIF"

        ' display UNSORTED original array

        sortDynamically(New Integer() {0}, RichTextBox1)

    End Sub


    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        sortDynamically(New Integer() {1}, RichTextBox2)
        sortDynamically(New Integer() {1, 2}, RichTextBox3)
        sortDynamically(New Integer() {1, 2, 3}, RichTextBox4)

        MsgBox(Chr(10) & "  Sort accomplished ! " & Chr(10))

    End Sub


    Private Sub sortDynamically(ByVal sortBy() As Integer, ByVal outputTo As RichTextBox)

        Dim inner As Integer    ' create LOCAL var as per https://msdn.microsoft.com/en-us/library/bb763133.aspx

        sortedArr = DirectCast(arr.Clone, String(,))

        For outer As Integer = 0 To sortedArr.GetUpperBound(0)

            For avoidInnerVarCausingLambdaExpressionError As Integer = outer To 1 Step -1

                ' VS2013
                ' as per https://msdn.microsoft.com/en-us/library/bb763133.aspx
                ' dont use directly -inner- as iteration variable ! instead...
                ' ..Assign the value of the iteration variable to a local variable,
                ' and use the local variable in the lambda expression.
                inner = avoidInnerVarCausingLambdaExpressionError

                For x As Integer = 0 To sortBy.GetUpperBound(0)

                    Dim compareValue As Integer = 0

                    Select Case sortBy(x)
                        Case 1 'date
                            compareValue = CDate(sortedArr(inner, sortBy(x))).CompareTo(CDate(sortedArr(inner - 1, sortBy(x))))
                        Case 2 'integer  - bus id
                            compareValue = CInt(sortedArr(inner, sortBy(x)).Replace("bus-", "")).CompareTo(CInt(sortedArr(inner - 1, sortBy(x)).Replace("bus-", "")))
                        Case 3 'timespan - dep time
                            compareValue = TimeSpan.Parse(sortedArr(inner, sortBy(x))).CompareTo(TimeSpan.Parse(sortedArr(inner - 1, sortBy(x))))
                        Case 4 'integer  - rec nbr - must show original unsorted array (as in RichTextBox1)
                            compareValue = CInt(sortedArr(inner, sortBy(x))).CompareTo(CInt(sortedArr(inner - 1, sortBy(x))))
                        Case 5 'string  - driver id
                            compareValue = sortedArr(inner, sortBy(x)).CompareTo(sortedArr(inner - 1, sortBy(x)))
                    End Select

                    If compareValue = 0 Then
                        Continue For
                    ElseIf compareValue = -1 Then
                        Dim temp() As String = Enumerable.Range(0, sortedArr.GetLength(1)).Select(Function(i) sortedArr(inner, i)).ToArray
                        For i As Integer = 0 To temp.GetUpperBound(0)
                            sortedArr(inner, i) = sortedArr(inner - 1, i)
                            sortedArr(inner - 1, i) = temp(i)
                        Next
                    End If

                    Exit For

                Next x

            Next avoidInnerVarCausingLambdaExpressionError

        Next outer

        displayResults(outputTo)

    End Sub

    Private Sub displayResults(ByVal outputTo As RichTextBox)
        Dim s As String = ""
        outputTo.Text = "start"
        For n = 0 To maxRec
            For j = 1 To maxFields
                s &= sortedArr(n, j) & Space(3)  ' 3 spaces provide better readability...
            Next
            outputTo.Text &= Chr(10) & s
            s = ""
        Next
        outputTo.Text &= Chr(10) & "end"
    End Sub


End Class

---

Attachment 125729