'**********************************************************************************************************
' Name:                 sortArray2D
' Author:               mielk | 2013-03-13
'
' Comment:              Method to sort the given two-dimensional array by the selected column.
'
' Parameters:
'   arr                 Array to be sorted.
'   column              The index of column by which the given array is to be
'                       sorted.
'   ascending           Optional parameter. The order of sorting.
'                       If this parameter is set to True, the array will be sorted in ascending order.
'                       Default value of this parameter is True.
'   hasHeader           s
'
'
' Exceptions:
'   NotArrayException               Thrown if the given parameter is not an array.
'   DimensionsException             Thrown if the array passed to this function has less or
'                                   more than 2 dimensions.
'   ColumnOutOfRangeException       Thrown if the given column by which the array is to be sorted is
'                                   greater than the total number of columns in this array.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-03-13        mielk           Method created.
'**********************************************************************************************************
Public Sub sortArray2D(arr As Variant, column As Integer, Optional ascending As Boolean = True, _
                                                                     Optional hasHeader As Boolean = False)
    Const METHOD_NAME As String = "sortArray2D"
    '------------------------------------------------------------------------------------------------------
    Dim orderArray() As Variant
    Dim tempArray As Variant
    Dim lngRow As Long                     'Rows iterator
    Dim lngCol As Long                  'Columns iterator
    Dim lngIndex As Long
    Dim bytHeader As Byte: bytHeader = VBA.IIf(hasHeader, 1, 0)
    '------------------------------------------------------------------------------------------------------

    
    'Checks if the given parameter [arr] is an array. If not, code --------------------------------------|
    'execution moves to the NotArrayException label.                                                    '|
    If Not isDefinedArray(arr) Then GoTo NotArrayException                                              '|
    '----------------------------------------------------------------------------------------------------|
    
    
    'Only 2-dimensional arrays can be sorted by this function, so check if the array passed -------------|
    'as a parameter has exactly two dimensions. If it has less or more dimensions, code execution       '|
    'moves to the DimensionsException label.                                                            '|
    If countDimensions(arr) <> 2 Then GoTo DimensionsException                                          '|
    '----------------------------------------------------------------------------------------------------|


    'Checks if the given column index is in range of this array. ----------------------------------------|
    If UBound(arr, 1) < column Or LBound(arr, 1) > column Then GoTo ColumnOutOfRangeException           '|
    '----------------------------------------------------------------------------------------------------|
    
    
    'Checks if the given array has more than one item. If there is only one item, -----------------------|
    'there is no point to sort it.                                                                      '|
    If UBound(arr, 2) <= (1 + VBA.IIf(hasHeader, 1, 0)) Then GoTo SingleItemArray                       '|
    '----------------------------------------------------------------------------------------------------|
    
    
    'Creates the temporary array to be used as a map where the index number of the row is the key -------|
    'and the value in the specified column of the array is associated to this key.                      '|
    ReDim Preserve orderArray(1 To 2, LBound(arr, 2) + bytHeader To UBound(arr, 2))                     '|
    For lngRow = LBound(arr, 2) + bytHeader To UBound(arr, 2)                                           '|
        orderArray(1, lngRow) = lngRow                                                                  '|
        orderArray(2, lngRow) = arr(column, lngRow)                                                     '|
    Next lngRow                                                                                         '|
    '----------------------------------------------------------------------------------------------------|

    
    'Temporary array is now passed to the subroutine subSortArray2D, where it will be sorted by the -----|
    'value from given column.                                                                           '|
    Call subSortArray2D(orderArray, ascending)                                                          '|
    '----------------------------------------------------------------------------------------------------|
    
    
    'Create a new array with content of the source array before sorting. --------------------------------|
    tempArray = arr                                                                                     '|
                                                                                                        '|
    'The source array itself is filled from scratch with the values in the proper order (based on       '|
    'the sorted indices returned in [orderArray]).                                                      '|
    For lngRow = LBound(arr, 2) + bytHeader To UBound(arr, 2)                                           '|
                                                                                                        '|
        lngIndex = orderArray(1, lngRow)                                                                '|
                                                                                                        '|
        '--------------------------------------------------------------------------------------------|  '|
        For lngCol = LBound(arr, 1) To UBound(arr, 1)                                               '|  '|
            If VBA.IsObject(tempArray(lngCol, lngIndex)) Then                                       '|  '|
                Set arr(lngCol, lngRow) = tempArray(lngCol, lngIndex)                               '|  '|
            Else                                                                                    '|  '|
                arr(lngCol, lngRow) = tempArray(lngCol, lngIndex)                                   '|  '|
            End If                                                                                  '|  '|
        Next lngCol                                                                                 '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    Next lngRow                                                                                         '|
    '----------------------------------------------------------------------------------------------------|
    
    
'==========================================================================================================
ExitPoint:
    Exit Sub
    
    
'----------------------------------------------------------------------------------------------------------
NotArrayException:
    'Error handling for the case when the parameter passed to the function is not an array ...
    GoTo ExitPoint
    
    
DimensionsException:
    'Error handling for the case when the number of dimensions of the array passed to this function
    'is different than 2 ...
    GoTo ExitPoint
    
    
ColumnOutOfRangeException:
    'Error handling for the case when the given column index is greater than the total number of
    'columns in this array ...
    GoTo ExitPoint
    
    
SingleItemArray:
    'Source array has only one item, so there is no point to sort it. Leave the method without action.
    GoTo ExitPoint

End Sub




'**********************************************************************************************************
' Name:                 subSortArray2D
' Author:               mielk | 2013-03-13
'
' Comment:              Submethod used by sortArray2D method to sort the given map of row indices
'                       and values.
'
'
' Parameters:
'   arr                 Map Key-Value where the index of the row in the original array is used as a key
'                       and the value of this row in the specified column is used as a value.
'                       The map will be sorted by this function in the specified order and used later on
'                       to populate the result array with the values.
'   ascending           The order of sorting.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-03-13        mielk           Method created.
'**********************************************************************************************************
Private Sub subSortArray2D(arr() As Variant, ascending As Boolean)
    Const METHOD_NAME As String = "subSortArray2D"
    '------------------------------------------------------------------------------------------------------
    Dim lowerArr() As Variant       'Subarray with smaller values
    Dim higherArr() As Variant      'Subarray with greater values
    Dim finalArray() As Variant
    Dim lowIndex As Long
    Dim highIndex As Long
    Dim iRow As Long
    Dim iLower As Long
    Dim iHigher As Long
    '------------------------------------------------------------------------------------------------------


    'Check for the bounds of the array. -----------------------------------------------------------------|
    lowIndex = LBound(arr, 2)                                                                           '|
    highIndex = UBound(arr, 2)                                                                          '|
    '----------------------------------------------------------------------------------------------------|


    'Create two temporary arrays - one dedicated for records with lower values than the base value, -----|
    'the other one for higher values.                                                                   '|
    'They are being given the maximum possible size (the same as the size of the original array),       '|
    'to avoid time-consuming resizing later on.                                                         '|
    ReDim Preserve lowerArr(1 To 2, 1 To highIndex - lowIndex)                                          '|
    ReDim Preserve higherArr(1 To 2, 1 To highIndex - lowIndex)                                         '|
    '----------------------------------------------------------------------------------------------------|


    'Check if the array has more than 1 item. If it has only one item there is no point to sort it. -----|
    If highIndex - lowIndex > 0 Then                                                                    '|
                                                                                                        '|
        'Iterate through all the values of the original array and compare them to the first item ----|  '|
        'in this array.                                                                             '|  '|
        'If the value in the second column of the row is lower than the                             '|  '|
        'based value, this row is being added to the [lowerArr] array,                              '|  '|
        'otherwise it is being added to the [higherArr] array.                                      '|  '|
        For iRow = lowIndex + 1 To highIndex                                                        '|  '|
            If arr(2, iRow) < arr(2, lowIndex) Then                                                 '|  '|
                iLower = iLower + 1                                                                 '|  '|
                lowerArr(1, iLower) = arr(1, iRow)                                                  '|  '|
                lowerArr(2, iLower) = arr(2, iRow)                                                  '|  '|
            Else                                                                                    '|  '|
                iHigher = iHigher + 1                                                               '|  '|
                higherArr(1, iHigher) = arr(1, iRow)                                                '|  '|
                higherArr(2, iHigher) = arr(2, iRow)                                                '|  '|
            End If                                                                                  '|  '|
        Next iRow                                                                                   '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
        'Resize the [lowerArr] subarray to remove empty slots. --------------------------------------|  '|
        'Then it is checked how many items it has. If it has more than one                          '|  '|
        'this method is called recursively on this subarray.                                        '|  '|
        If iLower Then                                                                              '|  '|
            ReDim Preserve lowerArr(1 To 2, 1 To iLower)                                            '|  '|
            If iLower > 1 Then Call subSortArray2D(lowerArr, ascending)                             '|  '|
        End If                                                                                      '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
        'The same operations are executed on the [higherArr] subarray. ------------------------------|  '|                                                                                                        '|
        If iHigher Then                                                                             '|  '|
            ReDim Preserve higherArr(1 To 2, 1 To iHigher)                                          '|  '|
            If iHigher > 1 Then Call subSortArray2D(higherArr, ascending)                           '|  '|
        End If                                                                                      '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    'Final array is resized to accomodate all the records from the original array. ----------------------|
    ReDim Preserve finalArray(1 To 2, lowIndex To highIndex)                                            '|
    iRow = lowIndex                                                                                     '|
    '----------------------------------------------------------------------------------------------------|


    'If the order is set to ascending, the values from the subarray [lowerArr] are added first. ---------|
    'Otherwise the values from [higherArr] subarray will be inserted first.                             '|
    If ascending Then                                                                                   '|
        Call subSortArray2D_insert(finalArray, lowerArr, iLower, iRow)                                  '|
    Else                                                                                                '|
        Call subSortArray2D_insert(finalArray, higherArr, iHigher, iRow)                                '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|
                                                                                                        
                                                                                                        
    'The based value is inserted in the middle of the final array. --------------------------------------|
    finalArray(1, iRow) = arr(1, lowIndex)                                                              '|
    finalArray(2, iRow) = arr(2, lowIndex)                                                              '|
    iRow = iRow + 1                                                                                     '|
    '----------------------------------------------------------------------------------------------------|
                                                                                                        
                                                                                                        
    'Finally, the items from the last subarray ([higherArr] or [lowerArr], depending on the value -------|
    'of parameter [ascending]) final array.                                                             '|
    If ascending Then                                                                                   '|
        Call subSortArray2D_insert(finalArray, higherArr, iHigher, iRow)                                '|
    Else                                                                                                '|
        Call subSortArray2D_insert(finalArray, lowerArr, iLower, iRow)                                  '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|
    
    
    'The final array is assigned to variable [arr] and overwrites its current values (in fact the
    'values are the same, but their order has changed).
    arr = finalArray
    
    
End Sub




'**********************************************************************************************************
' Name:                 subSortArray2D_insert
' Author:               mielk | 2013-03-13
'
' Comment:              Submethod of sortArray2D method to add the given subarray into the final array.
'
'
' Parameters:
'   finalArray          The reference to the final map Key-Value.
'   subarray            Sorted subarray.
'   index               The index of row where the first item of partArray should be added.
'   row                 The index of the row in the final array, where the first item from subarray
'                       should be inserted.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-03-13        mielk           Method created.
'**********************************************************************************************************
Private Sub subSortArray2D_insert(finalArray() As Variant, subarray() As Variant, items As Long, _
                                                                                              iRow As Long)
    Const METHOD_NAME As String = "subSortArray2D_insert"
    '------------------------------------------------------------------------------------------------------
    Dim jRow As Long
    '------------------------------------------------------------------------------------------------------
    
    
    'If there are any items in the given subarray ... ---------------------------------------------------|
    If items Then                                                                                       '|
                                                                                                        '|
        '... iterate through them and add them to the final array [arr]. ----------------------------|  '|
        For jRow = 1 To items                                                                       '|  '|
            finalArray(1, iRow) = subarray(1, jRow)                                                 '|  '|
            finalArray(2, iRow) = subarray(2, jRow)                                                 '|  '|
            iRow = iRow + 1                                                                         '|  '|
        Next jRow                                                                                   '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|
    
    
End Sub




'**********************************************************************************************************
' Name:         isDefinedArray
' Author:       mielk | 2012-03-27
'
' Description:  Function to check if the given parameter is an array with dimensions and sizes already
'               declared.
'
' Parameters:
'   arr         Parameter to be tested.
'
' Returns:
'   Boolean     True - if parameter [arr] is an array and its dimensions and sizes has been already
'                      defined.
'               False - if parameter [arr] is not an array or it is declared as a dynamic array but its
'                      dimension and size have not been defined yet.
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-03-27        mielk       Function created.
' 2014-08-10        mielk       Case about arrays with negative up bound instead of being not declared.
'**********************************************************************************************************
Public Function isDefinedArray(arr As Variant) As Boolean
    Const METHOD_NAME As String = "isDefinedArray"
    '------------------------------------------------------------------------------------------------------
    Dim upBound As Long
    Dim lowBound As Long
    '------------------------------------------------------------------------------------------------------
    
    
    'Try to assign bottom and top bound of the given parameter.
    'If it is not an array or is not declared yet, code will move to
    'the label NotArrayException and function will return False.
    On Error GoTo NotArrayException
    upBound = UBound(arr, 1)
    lowBound = LBound(arr, 1)
    
    'In some cases, it is possible to get LBound and UBound of a dynamic array
    'althought it is not declared yet (i.e. arrays returned as a result of VBA
    'built-in Split function if empty string is passed as a parameter),
    'however in this case UBound will be lower than LBound.
    isDefinedArray = (upBound >= lowBound)


'==========================================================================================================
ExitPoint:
    Exit Function

'----------------------------------------------------------------------------------------------------------
NotArrayException:
    GoTo ExitPoint
    
End Function




'**********************************************************************************************************
' 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