[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Better Sort Algorithm

Posted on 1998-08-19
2
Medium Priority
?
280 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 

Accepted Solution

by:
hansbos earned 200 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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
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…
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…
Suggested Courses

650 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