Solved

Better Sort Algorithm

Posted on 1998-08-19
2
275 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
ID: 1429965
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
ID: 1429966
Thanks A lot!!
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

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

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
VB error "Type mismatch" 2 61
VBA/SQL - Connect to SQL server and pull data 4 120
passing a value with stream reader AFTER a ";" 3 75
Collapse and expand table in Word 2010 2 39
Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

821 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