'**********************************************************************************************************
' Name:         transposeArray
' Author:       mielk | 2012-06-21
'
' Comment:      Function to transpose the given two dimensional array.
'
'               There is an Excel built-in function to transpose arrays:
'               Application.WorksheetFunction.Transpose. However, there are many cases when this function
'               doesn't work properly and throws errors, i.e. if the array to be transposed has more
'               than 65536 rows or the content of any array cell is longer than 255 characters
'               ([Run-time error '13': Type mismatch] is generated by the compiler in both those cases).
'
'               This function allows to get around those limitations.
'
' Parameters:
'   arr         The array to be transposed.
'               It needs to have exactly two dimensions.
'               If this parameter is not an array or have less or more than two dimensions, the exceptions
'               are thrown.
'
' Returns:
'   Array()     The source array after being transposed.
'
'
' 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 (only
'               2-dimensional arrays can be transponed).
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-06-21        mielk           Method created.
' 2015-02-15        mielk           Function doesn't rely on Excel built-in transpose function anymore.
'                                   This function returned unexpected results - all items of Data type were
'                                   converted to String representation of those dates.
'**********************************************************************************************************
Public Function transposeArray(ByRef arr As Variant) As Variant()
    Const METHOD_NAME As String = "transposeArray"
    '------------------------------------------------------------------------------------------------------
    Dim lngRow As Long                     'Rows iterator
    Dim lngCol As Long                  'Columns iterator
    Dim lWidth As Long
    Dim lHeight As Long
    Dim stWidth As Long
    Dim stHeight As Long
    Dim tempArray() As Variant
    Dim dimensions As Integer
    '------------------------------------------------------------------------------------------------------

    
    '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 transponed. Function checks 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.
    dimensions = countDimensions(arr)
    If dimensions <> 2 Then GoTo DimensionsException


    stWidth = LBound(arr, 1)
    stHeight = LBound(arr, 2)
    lWidth = UBound(arr, 1)
    lHeight = UBound(arr, 2)

    'Temporary array [tempArray] is given the target size.
    ReDim tempArray(stHeight To lHeight, stWidth To lWidth)
    For lngRow = stWidth To lWidth
        For lngCol = stHeight To lHeight
        
            If VBA.IsObject(arr(lngRow, lngCol)) Then
                Set tempArray(lngCol, lngRow) = arr(lngRow, lngCol)
            Else
                tempArray(lngCol, lngRow) = arr(lngRow, lngCol)
            End If
            
        Next lngCol
    Next lngRow

    'Newly created array [tempArray] is being assigned to the result variable.
    transposeArray = tempArray
    
    
'==========================================================================================================
ExitPoint:
    Exit Function
    
    
'----------------------------------------------------------------------------------------------------------
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

End Function




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