m_QuickSort.bas

'******************************************************************************
' Author: TODO
' Description: TODO
' Version: 0.1
' Instructions: TODO
' Revisions: TODO
'            - Date: yyyy/mm/dd
'            - Author:
'            - Description:
'@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: Quick sort a 1D array.
' Arguments: vArray - an array to sort
'            inLow - number of elements in the lower segment
'            inHi - number of elements in the higher segment
' How to use: Call QuickSort(myArray, LBound(myArray), UBound(myArray))
'******************************************************************************
Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)

    ' 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 pivot As Variant
    Dim tmpSwap As Variant
    Dim tmpLow As Long
    Dim tmpHi As Long
    
    '**************************************************************************
    ' TODO: Main Code
    On Error GoTo ErrorHandling
    
    tmpLow = inLow
    tmpHi = inHi
    pivot = vArray((inLow + inHi) \ 2)
    
    While (tmpLow <= tmpHi)
    
        While (vArray(tmpLow) < pivot And tmpLow < inHi)
            tmpLow = tmpLow + 1
        Wend
        
        While (pivot < vArray(tmpHi) And tmpHi > inLow)
            tmpHi = tmpHi - 1
        Wend
        
        If (tmpLow <= tmpHi) Then
            tmpSwap = vArray(tmpLow)
            vArray(tmpLow) = vArray(tmpHi)
            vArray(tmpHi) = tmpSwap
            tmpLow = tmpLow + 1
            tmpHi = tmpHi - 1
        End If
    Wend
    
    If (inLow < tmpHi) Then
        QuickSort vArray, inLow, tmpHi
    End If
    
    If (tmpLow < inHi) Then
        QuickSort vArray, tmpLow, inHi
    End If
    
    Cleanup currentWorksheet, executionRuntime
    Exit Sub
    
ErrorHandling:
    ErrHandler currentWorksheet, executionRuntime
End Sub