Sort Module For Strings and Numbers

Category:

Lists, Collections and Arrays

Type:

Modules

Difficulty:

Intermediate

Author:

Anonymous

Version Compatibility: Visual Basic 6

More information:

Usage is explained and and example is given within the comments.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit 'EXAMPLE USAGE OF BOTH PUBLIC FUNCTIONS: 'SEE http://www.freevbcode.com/ShowCode.Asp?ID=55 'FOR THE RANDOMNUMBER FUNCTION USED IN THIS EXAMPLE 'Dim iArray(9) As Variant 'Dim sArray(9) As String 'Dim iCtr As Integer ' ' 'For iCtr = 0 To 9 ' iArray(iCtr) = RandomNumber(10000, 0) ' sArray(iCtr) = Chr(RandomNumber(90, 65)) 'Next ' 'StrSort sArray, False, False 'NumSort iArray, False ' 'For iCtr = 0 To 9 ' Debug.Print iArray(iCtr) ' Debug.Print sArray(iCtr) 'Next

Code:

Public Static Sub StrSort(words() As String, _ 
   Ascending As Boolean, AllLowerCase As Boolean)
 
'Pass in string array you want to sort by reference and
'read it back

'Set Ascending to True to sort ascending, '
'false to sort descending

'If AllLowerCase is True, strings will be sorted
'without regard to case.  Otherwise, upper
'case characters take precedence over lower
'case characters

Dim I As Integer
Dim J As Integer
Dim NumInArray, LowerBound As Integer
NumInArray = UBound(words)
LowerBound = LBound(words)
For I = LowerBound To NumInArray
    J = 0
    For J = LowerBound To NumInArray
        If AllLowerCase = True Then
            If Ascending = True Then
                If StrComp(LCase(words(I)), _
                     LCase(words(J))) = -1 Then
                    Call Swap(words(I), words(J))
                End If
            Else
                If StrComp(LCase(words(I)), _
                       LCase(words(J))) = 1 Then
                    Call Swap(words(I), words(J))
                End If
            End If
        Else
            If Ascending = True Then
                If StrComp(words(I), words(J)) = -1 Then
                    Call Swap(words(I), words(J))
                End If
            Else
                If StrComp(words(I), _
                    words(J)) = 1 Then
                    Call Swap(words(I), words(J))
                End If
            End If
        End If
    Next J
Next I
End Sub

Public Static Sub NumSort(nums() As Variant, Ascending As _
   Boolean)

'Pass in numeric array you want to sort by reference and
'read it back.  The array should be declared as an array
'of variants

'Set Ascending to True to sort ascending, 
'false to sort descending

Dim I As Integer
    Dim J As Integer
    Dim NumInArray, LowerBound As Integer
    NumInArray = UBound(nums)
    LowerBound = LBound(nums)
    For I = LowerBound To NumInArray
        J = 0
        For J = LowerBound To NumInArray
            If Ascending = True Then
                If nums(I) < nums(J) Then
                    NumSwap nums(I), nums(J)
                End If
            Else
                If nums(I) > nums(J) Then
                    NumSwap nums(I), nums(J)
                End If
            End If
        Next J
    Next I
End Sub

Private Sub NumSwap(var1 As Variant, var2 As Variant)
    Dim x As Variant
    x = var1
    var1 = var2
    var2 = x
End Sub

Private Sub Swap(var1 As String, var2 As String)
    Dim x As String
    x = var1
    var1 = var2
    var2 = x
End Sub