m_CollectionSort.bas

'******************************************************************************
' Author: VascoFerreira
' Description: Sort arrays with collections
' Version: 0.1
' Instructions: TODO
' Revisions: TODO
'            - Date: 2019/03/07
'            - Author: Vasco Ferreira
'            - Description: Init
'@Folder("Utilities.Sort")
Option Explicit
'******************************************************************************

'******************************************************************************
' Description: Increase performance by disabling the screen update
'              and automatic calculations.
'******************************************************************************
Sub ToggleExcelUpdates(toggle As Boolean)
    Application.ScreenUpdating = toggle
    Application.DisplayStatusBar = toggle
    Application.EnableEvents = toggle
    
    If toggle Then
        Application.Calculation = xlAutomatic
        Application.Calculate
    Else
        Application.Calculation = xlManual
    End If
End Sub

'******************************************************************************
' Description: Executes cleanup code at the end of each Sub, re-activates the
'              current worksheet and shows the Sub runtime.
'              It can be made public to handle cleanup code on other modules.
' Arguments: currentWorksheet
'            startingTime - value of starting time
'******************************************************************************
Private Sub Cleanup(currentWorksheet As Worksheet, startingTime As Double)
    ' Re-enable Screen update and automatic calculations
    ToggleExcelUpdates True
    
    ' Re-activate current worksheet
    currentWorksheet.Activate
    
    ' Show executionRuntime
    ' MsgBox "Execution time: " & _
           (Timer - startingTime) & " seconds.", _
           vbOkOnly + vbInformation, "Procedure Execution Time"
    Debug.Print "Execution time: " & (Timer - startingTime) & " seconds."
End Sub

'******************************************************************************
' Description: Handles all the errors and executes cleanup code afterwards
'              It can be made public to handle cleanup code on other modules.
' Arguments: currentWorksheet
'            startingTime - value of starting time
'******************************************************************************
Private Sub ErrHandler(currentWorksheet As Worksheet, startingTime As Double)
    ' Handle specific errors
    Select Case Err.Number
        Case 0
            ' No error
    End Select
    
    ' Show the Error Handling form with the error number and message
    'frm_ErrorHandling.DisplayErrorForm Err.Number, Err.Description
    Debug.Print "+++ Error: " & Err.Number & ": " & Err.Description

    Cleanup currentWorksheet, startingTime
End Sub

'******************************************************************************
' Description: Sort an array using a collection and then replacing the values
' Arguments: sortArray - an array to sort
'******************************************************************************
Sub CollectionSort(sortArray As Variant)

    ' Turn off screen update and automatic calculations
    ToggleExcelUpdates False
    
    ' Start Sub timer
    Dim executionRuntime As Double
    executionRuntime = Timer
    
    Dim currentWorkbook As Workbook
    Dim currentWorksheet As Worksheet
    
    ' `ThisWorkbook` won't work when an add-in tries to manipulate another
    ' workbook because `ThisWorkbook` will point to the add-in's workbook.
    Set currentWorkbook = ActiveWorkbook
    Set currentWorksheet = currentWorkbook.ActiveSheet
    
    '**************************************************************************
    ' Variables Declaration
    Dim sortedCollection As Collection
    Dim collectionElement As Variant
    Dim elementIndex As Long
    Dim addedToCol As Boolean
    Dim arrayElement As Variant
    
    '**************************************************************************
    ' TODO: Main Code
    On Error GoTo ErrorHandling
    
    Set sortedCollection = New Collection
    
    For Each arrayElement In sortArray
        ' Check if sorted collection is not empty
        If sortedCollection.Count <> 0 Then
            elementIndex = 1
            addedToCol = False
            
            ' Compare the array element to each coll element
            ' If it is smaller, prepend to the collection
            For Each collectionElement In sortedCollection
                If arrayElement < collectionElement Then
                    sortedCollection.Add arrayElement, Before:=elementIndex
                    addedToCol = True
                    Exit For
                End If
                elementIndex = elementIndex + 1
            Next collectionElement
            
            ' If the array element is greater than any col element
            ' append it to the collection
            If Not addedToCol Then
                sortedCollection.Add arrayElement, After:=elementIndex - 1
            End If
        Else
            ' If collection is empty, add the first array element
            sortedCollection.Add arrayElement
        End If
    Next arrayElement
    
    elementIndex = LBound(sortArray)
    For Each collectionElement In sortedCollection
        sortArray(elementIndex) = collectionElement
        elementIndex = elementIndex + 1
    Next collectionElement
    
    Cleanup currentWorksheet, executionRuntime
    Exit Sub
    
ErrorHandling:
    ErrHandler currentWorksheet, executionRuntime
End Sub