'**********************************************************************************************************
' Name:                 sortArray1D
' Author:               mielk | 2013-04-26
'
' Comment:              Method to sort the given 1D array in the specified order.
'
' Parameters:
'   arr                 1D array to be sorted.
'   ascending           Optional parameter of Boolean type.
'                       It determines if the array should be sorted in ascending order. By default arrays
'                       are sorted in ascending order.
'
'
' Exceptions:
'   NotArrayException               Thrown if the given parameter is not an array.
'   TooManyDimensionsException      Thrown if the given array has more than one dimension.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-04-26        mielk           Method created.
'**********************************************************************************************************
Public Sub sortArray1D(arr As Variant, Optional ascending As Boolean = True)
    Const METHOD_NAME As String = "sortArray1D"
    '------------------------------------------------------------------------------------------------------
    Dim arrGreater() As Variant
    Dim arrLower() As Variant
    Dim varBaseValue As Variant
    Dim lngLBound As Long
    Dim lngUBound As Long
    Dim lngRow As Long
    Dim lngLowerCount As Long
    Dim lngGreaterCount As Long
    '------------------------------------------------------------------------------------------------------


    'Check if the given parameter is an array and if it has only one dimension. -------------------------|
    If Not VBA.IsArray(arr) Then GoTo NotArrayException                                                 '|
    If countDimensions(arr) <> 1 Then GoTo TooManyDimensionsException                                   '|
    '----------------------------------------------------------------------------------------------------|


    'Work out bounds of the given array. '---------------------------------------------------------------|
    lngLBound = LBound(arr, 1)                                                                          '|
    lngUBound = UBound(arr, 1)                                                                          '|
    '----------------------------------------------------------------------------------------------------|
    
    
    'If up bound of the given array is lower than or equal to the low bound of the same array, '---------|
    'it means this array has only one element or has not elements at all. In both those cases           '|
    'there is no point to sort it.                                                                      '|
    If lngUBound <= lngLBound Then GoTo NothingToSort                                                   '|
    '----------------------------------------------------------------------------------------------------|


    'Resize the temporary arrays to make them capable to store all elements of the source array. --------|
    ReDim Preserve arrLower(1 To lngUBound - lngLBound)                                                 '|
    ReDim Preserve arrGreater(1 To lngUBound - lngLBound)                                               '|
    '----------------------------------------------------------------------------------------------------|


    'Each element of the source array is being compared to the base value (in fact - the first ----------|
    'element in the source array) and added to the proper subarray, depending on if it is               '|
    'greater or lower than the base value.                                                              '|
    If lngUBound - lngLBound > 0 Then                                                                   '|
                                                                                                        '|
        '--------------------------------------------------------------------------------------------|  '|
        For lngRow = lngLBound + 1 To lngUBound                                                     '|  '|
                                                                                                    '|  '|
            '------------------------------------------------------------------------------------|  '|  '|
            If arr(lngRow) < arr(1) Then                                                        '|  '|  '|
                lngLowerCount = lngLowerCount + 1                                               '|  '|  '|
                arrLower(lngLowerCount) = arr(lngRow)                                           '|  '|  '|
            Else                                                                                '|  '|  '|
                lngGreaterCount = lngGreaterCount + 1                                           '|  '|  '|
                arrGreater(lngGreaterCount) = arr(lngRow)                                       '|  '|  '|
            End If                                                                              '|  '|  '|
            '------------------------------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
        Next lngRow                                                                                 '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
        'If there are any items in the temporary [arrLower] array - sort them by the same rules. ----|  '|
        If lngLowerCount Then                                                                       '|  '|
            ReDim Preserve arrLower(1 To lngLowerCount)                                             '|  '|
            If lngLowerCount > 1 Then Call sortArray1D(arrLower, ascending)                         '|  '|
        End If                                                                                      '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
        'If there are any items in the temporary [arrGreater] array - sort them by the same rules. --|  '|
        If lngGreaterCount Then                                                                     '|  '|
            ReDim Preserve arrGreater(1 To lngGreaterCount)                                         '|  '|
            If lngGreaterCount > 1 Then Call sortArray1D(arrGreater, ascending)                     '|  '|
        End If                                                                                      '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|



    'At this point values have been already sorted by recurrentive calls of this function. --------------|
    'Now they are being added to the final array.                                                       '|
    varBaseValue = arr(lngLBound)                                                                       '|
    lngRow = lngLBound                                                                                  '|
                                                                                                        '|
    'If array should be sorted in ascending order, first items from [arrLower] array must be --------|  '|
    'inserted into final array. For descending order, first items from [arrGreater] are added.      '|  '|
    If ascending Then                                                                               '|  '|
        Call sortArray1D_insert(arr, arrLower, lngLowerCount, lngRow)                               '|  '|
    Else                                                                                            '|  '|
        Call sortArray1D_insert(arr, arrGreater, lngGreaterCount, lngRow)                           '|  '|
    End If                                                                                          '|  '|
    '------------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    arr(lngRow) = varBaseValue                                                                          '|
    lngRow = lngRow + 1                                                                                 '|
                                                                                                        '|
    'If array is to be sorted in ascending order, items from [arrGreater] temporary subarray are ----|  '|
    'added as last ones. For descending order, items from [arrLower] are added at the end.          '|  '|
    If ascending Then                                                                               '|  '|
        Call sortArray1D_insert(arr, arrGreater, lngGreaterCount, lngRow)                           '|  '|
    Else                                                                                            '|  '|
        Call sortArray1D_insert(arr, arrLower, lngLowerCount, lngRow)                               '|  '|
    End If                                                                                          '|  '|
    '------------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    '----------------------------------------------------------------------------------------------------|


'==========================================================================================================
ExitPoint:
    Exit Sub

'----------------------------------------------------------------------------------------------------------
NotArrayException:
    '(...)
    'Put your own error handling here for a case if the given parameter is not an array.
    
    GoTo ExitPoint
    
    
TooManyDimensionsException:
    '(...)
    'Put your own error handling here for a case if the given array has more than one dimension.
    
    GoTo ExitPoint


NothingToSort:
    'The given array has only one element or has not elements at all. There is no point to sort it, so
    'leave this functions without altering the source array.
    GoTo ExitPoint

End Sub




'**********************************************************************************************************
' Name:                 sortArray1D_insert
' Author:               mielk | 2013-04-26
'
' Comment:              Subfunction used to insert values already sorted into the final array.
'
' Parameters:
'   arr                 Final array.
'   tempArray           Temporary array which items are to be added to the final array.
'   lngItems            The number of items in the temporary array.
'   lngRow              The index of a row where adding items should start.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-04-26        mielk           Method created.
'**********************************************************************************************************
Private Sub sortArray1D_insert(arr As Variant, tempArray() As Variant, lngItems As Long, lngRow As Long)
    Const METHOD_NAME As String = "sortArray1D_insert"
    '------------------------------------------------------------------------------------------------------
    Dim jRow As Long
    '------------------------------------------------------------------------------------------------------
    
    
    'If there are any items in the given subarray ... ---------------------------------------------------|
    If lngItems Then                                                                                    '|
                                                                                                        '|
        '... iterate through them and add them to the final array [arr]. ----------------------------|  '|
        For jRow = 1 To lngItems                                                                    '|  '|
            arr(lngRow) = tempArray(jRow)                                                           '|  '|
            lngRow = lngRow + 1                                                                     '|  '|
        Next jRow                                                                                   '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    'Temporary array is not needed anymore so erase it to release memory.
    Erase tempArray


End Sub




'**********************************************************************************************************
' Name:         countDimensions
' Author:       mielk | 2012-03-03
'
' Comment:      Returns the number of dimensions of the given VBA array.
'
' Parameters:
'   arr         Array for which number of dimensions is to be returned.
'
' Returns:
'   Integer     The number of dimensions of the given VBA array.
'               If the given value is not an array function returns -1.
'               If the given value is declared as a dynamic array but its dimensions have not been
'               declared yet, 0 is returned.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-03-03        mielk       Function created.
' 2014-06-15        mielk       Returned type changed to Integer to allow -1 to be returned.
'                               For non-arrays values -1 is returned.
'**********************************************************************************************************
Public Function countDimensions(arr As Variant) As Integer
    Const METHOD_NAME As String = "countDimensions"
    '------------------------------------------------------------------------------------------------------
    Dim bound As Long
    '------------------------------------------------------------------------------------------------------


    If VBA.IsArray(arr) Then
        
        On Error GoTo NoMoreDimensions
        Do
            bound = UBound(arr, countDimensions + 1)
            countDimensions = countDimensions + 1
        Loop
        
    Else
        
        countDimensions = -1
        
    End If



'----------------------------------------------------------------------------------------------------------
NoMoreDimensions:

End Function