• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 282
  • Last Modified:

Better Sort Algorithm

  I am using a simple "Bubble Sort" to sort the elements in a MSFlexGrid.  This works very well for about 40 rows of data.  If you have more data, the user will notice the lag a lot more.  I was hoping that there is a "Quick Sort" algorithm for a MSFlexGrid that I could use.  I only need to sort the data in the grid based on the FieldNumber (Column) of the grid.  Below is my simple procedure for sorting the grid.  If you have a better algorithm (Quick Sort) or if you could make improvements in the way that I programmed the algorithm, it would be great!!  Thanks in advance.

Here is my simple Bubble Sort

Sub SortField(ByVal FieldNumber As Integer)

    Dim Continue As Boolean
    Dim i As Integer
    ReDim TempString(frmMain.msflexgrid1.Cols) As String
    Dim TempField As String
   
    Screen.MousePointer = 11
    With frmMain.msflexgrid1
    .Visible = False
    Continue = True
    Do While Continue = True
        Continue = False
        .Row = 1
        .Col = FieldNumber
        Do While .Row < .Rows - 1
            TempField = .Text
            .Row = .Row + 1
            If .Text < TempField Then
                For j = 0 To .Cols - 1
                    .Col = j
                    TempString(j) = .Text
                Next j
               
                For j = 0 To .Cols - 1
                    .Col = j
                    .Row = .Row - 1
                    TempField = .Text
                    .Row = .Row + 1
                    .Text = TempField
                Next j
               
                .Row = .Row - 1
                For j = 0 To .Cols - 1
                    .Col = j
                    .Text = TempString(j)
                Next j
                .Row = .Row + 1
                Continue = True
            End If
        Loop
    Loop
    .Visible = True
    End With
    Screen.MousePointer = 1
End Sub
0
2helpornot2help
Asked:
2helpornot2help
1 Solution
 
hansbosCommented:
2helpornot2help,

Here's a quicksort algorithm:

'*********************************************************************
' Sorts a Variant array using the QuickSort algorithm
'*********************************************************************
Public Sub QuickSort(vntArray As Variant, _
    Optional intLBound As Integer, Optional intUBound As Integer)
    '*****************************************************************
    ' Holds the pivot point
    '*****************************************************************
    Dim vntMid As Variant
    '*****************************************************************
    ' Make sure vntArray really is an array
    '*****************************************************************
    If (VarType(vntArray) And vbArray) = 0 Then Exit Sub
    '*****************************************************************
    ' If Optional args weren't provided, then get the default values
    '*****************************************************************
    If intLBound = 0 And intUBound = 0 Then
        intLBound = LBound(vntArray)
        intUBound = UBound(vntArray)
    End If
    '*****************************************************************
    ' If the LBound is greater than the UBound then there is nothing
    ' to do, so exit
    '*****************************************************************
    If intLBound > intUBound Then Exit Sub
    '*****************************************************************
    ' If there are only two elements in this array, then swap them
    ' (if necessary) and exit
    '*****************************************************************
    If (intUBound - intLBound) = 1 Then
        If Compare(vntArray(intLBound), vntArray(intUBound)) > 0 Then
            Swap vntArray(intLBound), vntArray(intUBound)
        End If
        Exit Sub
    End If
    '*****************************************************************
    ' Dim the indices
    '*****************************************************************
    Dim i As Integer, j As Integer
    '*****************************************************************
    ' Set your pivot point
    '*****************************************************************
    vntMid = vntArray(intUBound)
    '*****************************************************************
    ' Loop while lower bound is less than the upper bound
    '*****************************************************************
    Do
        '*************************************************************
        ' Init i and j to the array boundary
        '*************************************************************
        i = intLBound
        j = intUBound
        '*************************************************************
        ' Compare each element with vntMid (the pivot) until the
        ' current element is the less than or equal to the midpoint
        '*************************************************************
        Do While (i < j) And Compare(vntArray(i), vntMid) <= 0
            i = i + 1
        Loop
        '*************************************************************
        ' Compare each element with vntMid (the pivot) until the
        ' current element is the greater than or equal to the mid
        ' point
        '*************************************************************
        Do While (j > i) And Compare(vntArray(j), vntMid) >= 0
            j = j - 1
        Loop
        '*************************************************************
        ' If you never reached the pivot point then the two elements
        ' are out of order, so swap them
        '*************************************************************
        If i < j Then Swap vntArray(i), vntArray(j)
    Loop While i < j
    '*****************************************************************
    ' Now that i has been adjusted it the above loop, we should swap
    ' element i with element at intUBound
    '*****************************************************************
    Swap vntArray(i), vntArray(intUBound)
    '*****************************************************************
    ' If index i minus the index of intLBound is less than the index
    ' of intUBound minus index i then...
    '*****************************************************************
    If (i - intLBound) < (intUBound - i) Then
        '*************************************************************
        ' Recursively sort with adjusted values for upper and lower
        ' bounds
        '*************************************************************
        QuickSort vntArray, intLBound, i - 1
        QuickSort vntArray, i + 1, intUBound
    '*****************************************************************
    ' Otherwise...
    '*****************************************************************
    Else
        '*************************************************************
        ' Recursively sort with adjusted values for upper and lower
        ' bounds
        '*************************************************************
        QuickSort vntArray, i + 1, intUBound
        QuickSort vntArray, intLBound, i - 1
    End If
End Sub

'*********************************************************************
' Performs a binary search for vntFind on a variant array, and
' sorts the array if the call doesn't set blnIsSorted = True
'*********************************************************************
Public Function BinarySearch(vntArray As Variant, _
    vntFind As Variant, Optional blnIsSorted As Boolean) As Integer
    '*****************************************************************
    ' Dim integers for the high, low and mid points of the array
    '*****************************************************************
    Dim intHigh As Integer
    Dim intLow As Integer
    Dim intMid As Integer
    '*****************************************************************
    ' Make sure vntArray really is an array
    '*****************************************************************
    If VarType(vntArray) And vbArray Then
        intLow = LBound(vntArray)
        intHigh = UBound(vntArray)
    '*****************************************************************
    ' If it is not, then exit (returning a not found result)
    '*****************************************************************
    Else
        BinarySearch = -1
        Exit Function
    End If
    '*****************************************************************
    ' If the array isn't sorted, then sort it (otherwise your binary
    ' search will likely fail)
    '*****************************************************************
    If Not blnIsSorted Then QuickSort vntArray
    '*****************************************************************
    ' Enter into an infinite loop (because we'll exit the loop within
    ' our case statement)
    '*****************************************************************
    Do
        '*************************************************************
        ' Set the mid point of the half you are currently searching
        '*************************************************************
        intMid = intLow + ((intHigh - intLow) \ 2)
        '*************************************************************
        ' Compare the mid point element with the element you are
        ' searching for, and act accordingly based on the return
        ' value from Compare
        '*************************************************************
        Select Case Compare(vntFind, vntArray(intMid))
            '*********************************************************
            ' vntFind was found, so return the index and exit
            '*********************************************************
            Case 0
                BinarySearch = intMid
                Exit Function
            '*********************************************************
            ' vntFind is in the lower half, so set intHigh to the
            ' mid point and repeat the search
            '*********************************************************
            Case Is < 0
                intHigh = intMid
                '*****************************************************
                ' If intLow is equal to intHigh, then the item was
                ' not found so exit
                '*****************************************************
                If intLow = intHigh Then Exit Do
            '*********************************************************
            ' vntFind is in the upper half, so set intLow to the
            ' mid point plus one and repeat the search
            '*********************************************************
            Case Is > 0
                intLow = intMid + 1
                '*****************************************************
                ' If intLow is greater than intHigh, then the item
                ' was not found so exit
                '*****************************************************
                If intLow > intHigh Then Exit Do
        End Select
    Loop
    '*****************************************************************
    ' Item not found, then return a value less than the LBound
    '*****************************************************************
    BinarySearch = LBound(vntArray) - 1
End Function

'*********************************************************************
' SortSearch.bas - Routines to allow you to search and sort through
'   variant arrays
'*********************************************************************
Option Explicit
'*********************************************************************
' Option Compare Text makes the searches and sorts ignore case. Comment
' out this line if you wish to have case-sensitive searches and sorts.
'*********************************************************************
Option Compare Text
'*********************************************************************
' Same as StrComp, but applies to Variants
'*********************************************************************
Private Function Compare(vntItem1 As Variant, _
                         vntItem2 As Variant) As Integer
    '*****************************************************************
    ' Initialize the return value to 0
    Compare = 0
    '*****************************************************************
    ' If less than, then return -1
    '*****************************************************************
    If vntItem1 < vntItem2 Then
        Compare = -1
    '*****************************************************************
    ' If greater than, then return 1
    '*****************************************************************
    ElseIf vntItem1 > vntItem2 Then
        Compare = 1
    End If
    '*****************************************************************
    ' Otherwise do nothing, which returns zero (indicating that they
    ' are equal)
    '*****************************************************************
End Function
'*********************************************************************
' Swaps two variants - in place (since we are passing ByRef)
'*********************************************************************
Private Sub Swap(ByRef vntItem1 As Variant, ByRef vntItem2 As Variant)
    '*****************************************************************
    ' Dim a temp value to hold the original value of vntItem1
    '*****************************************************************
    Dim vntTemp As Variant
    '*****************************************************************
    ' Store vntItem1 in a temporary variable
    '*****************************************************************
    vntTemp = vntItem1
    '*****************************************************************
    ' Set vntItem2 equal to vntItem1
    '*****************************************************************
    vntItem1 = vntItem2
    '*****************************************************************
    ' Set vntItem2 equal to the temporary variable
    '*****************************************************************
    vntItem2 = vntTemp
End Sub

0
 
2helpornot2helpAuthor Commented:
Thanks A lot!!
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now