Solved

Better Sort Algorithm

Posted on 1998-08-19
2
271 Views
Last Modified: 2010-04-30
  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
Comment
Question by:2helpornot2help
2 Comments
 

Accepted Solution

by:
hansbos earned 100 total points
Comment Utility
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
 

Author Comment

by:2helpornot2help
Comment Utility
Thanks A lot!!
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now