Counting Sort

Counting Sort uses a 'counting' strategy to count the number of occurrences of each unique element in the array.

Sub TestSort() 
Dim avTesting() As Variant
   avTesting = Array(45, 30, 25, 15, 10, 5, 40, 20, 35, 50)
   Call Array_CountingSort(avTesting)
   Stop
End Sub
Public Sub Array_CountingSort(ByRef vArrayName As Variant) 
Dim vCounting() As Long
Dim lLower As Long
Dim lUpper As Long
Dim larraymin As Long
Dim larraymax As Long
Dim i As Long
Dim j As Long
Dim lnextpos As Long

    larraymin = Helper_Minimum(vArrayName)
    larraymax = Helper_Maximum(vArrayName)
    lLower = LBound(vArrayName)
    lUpper = UBound(vArrayName)
    
    ReDim vCounting(larraymin To larraymax)
    For i = lLower To lUpper
        vCounting(vArrayName(i)) = vCounting(vArrayName(i)) + 1
    Next i

    lnextpos = lLower
    For i = larraymin To larraymax
        For j = 1 To vCounting(i)
            vArrayName(lnextpos) = i
            lnextpos = lnextpos + 1
        Next j
    Next i
End Sub

Public Function Helper_Maximum(ByVal vArrayName As Variant) As Long
Dim lmaxvalue As Long
Dim lrowlower As Long
Dim lrowupper As Long
Dim i As Long
    lrowlower = LBound(vArrayName)
    lrowupper = UBound(vArrayName)
    lmaxvalue = vArrayName(lrowlower)
    For i = lrowlower To lrowupper
        If (vArrayName(i) > lmaxvalue) Then
            lmaxvalue = vArrayName(i)
        End If
    Next i
    Helper_Maximum = lmaxvalue
End Function

Public Function Helper_Minimum(ByVal vArrayName As Variant) As Long
Dim lminvalue As Long
Dim lrowlower As Long
Dim lrowupper As Long
Dim i As Long
    lrowlower = LBound(vArrayName)
    lrowupper = UBound(vArrayName)
    lminvalue = vArrayName(lrowlower)
    For i = lrowlower To lrowupper
        If (vArrayName(i) < lminvalue) Then
            lminvalue = vArrayName(i)
        End If
    Next i
    Helper_Minimum = lminvalue
End Function

© 2020 Better Solutions Limited. All Rights Reserved. © 2020 Better Solutions Limited TopPrevNext