Source code for Issue Number 11

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this code into any module (this is the desired way) or form. To do this, open up your project and insert a new Module. Change the name of the module to basArraySorting and paste this code into the module.

'----------------------------------------------------------------------
'
'   Module Name:    basArraySorting
'   Written By:     C&D Programming Corp.
'   Create Date:    11/15/97
'   Copyright:      Copyright 1997 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'
'   Purpose:        Sorting Text Arrays
'
'   Some of this code was original derived from
'   Microsoft Knowledge Base article number
'   153089
'
'
'----------------------------------------------------------------------

Public Sub SelectionSortText(vArray As Variant, ByVal sOrder As String)
    Dim lLoop1 As Long
    Dim lLoop2 As Long
    Dim lMin As Long
    Dim sTemp As String
    Dim lUBound As Long

    On Error GoTo Handler

    ' The code is duplicated except for the direction for
    ' speed purposes.  It will be faster to check only
    ' once for the sort direction instead of on each comparison.

    If LCase$(sOrder) = "ascending" Then
        lUBound = UBound(vArray)
        For lLoop1 = LBound(vArray) To lUBound - 1

            lMin = lLoop1

            ' Remeber this value for speed.  It's much
            ' faster to do an lcase$ and array index once.
            sTemp = LCase$(vArray(lMin))

            For lLoop2 = lLoop1 + 1 To lUBound
                If LCase$(vArray(lLoop2)) < sTemp Then
                    lMin = lLoop2
                    ' Remeber this value for speed.  It's much
                    ' faster to do an lcase$ and array index once.
                    sTemp = LCase$(vArray(lMin))
                End If
            Next lLoop2

            ' swap elements in the array
            sTemp = vArray(lMin)
            vArray(lMin) = vArray(lLoop1)
            vArray(lLoop1) = sTemp

        Next lLoop1

    Else

        For lLoop1 = LBound(vArray) To UBound(vArray) - 1

            lMin = lLoop1

            ' Remeber this value for speed.  It's much
            ' faster to do an lcase$ and array index once.
            sTemp = LCase$(vArray(lMin))

            For lLoop2 = lLoop1 + 1 To UBound(vArray)
                If LCase$(vArray(lLoop2)) > sTemp Then
                    lMin = lLoop2
                    ' Remeber this value for speed.  It's much
                    ' faster to do an lcase$ and array index once.
                    sTemp = LCase$(vArray(lMin))
                End If
            Next lLoop2

            ' swap array elements
            sTemp = vArray(lMin)
            vArray(lMin) = vArray(lLoop1)
            vArray(lLoop1) = sTemp

        Next lLoop1

    End If
    Exit Sub

Handler:
    Err.Raise Err.Number, "basArraySorting.SelectionSortText", Err.Description
End Sub