'**********************************************************************************************************
' Name:                 pasteData
' Author:               mielk | 2013-04-26
'
' Comment:              Method to paste the given array into the specified range of the given
'                       Excel worksheet.
'
' Parameters:
'   data                Data array to be pasted into Excel worksheet.
'   initRange           Top-left cell of the range, where the data array is to be pasted.
'   transponeData       Optional parameter of Boolean type. It defines if data should be transponed
'                       before being pasted into Excel worksheet.
'   clearContents       Optional parameter of Boolean type. It determines if the given Excel worksheet
'                       should be cleared before pasting new data.
'
'
' Exceptions:
'   InvalidRangeException           Thrown if the range given to the function as the [initRange] parameter
'                                   is invalid - i.e. the workbook it belongs to has been closed.
'   InvalidDataFormat               Thrown if the data given to this method are not 2D array and cannot be
'                                   converted to 2D array.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-04-26    mielk       Function created.
'**********************************************************************************************************
Public Sub pasteData(data As Variant, initRange As Excel.Range, Optional transponeData As Boolean = True, _
                                                                    Optional clearSheet As Boolean = False)
    Const METHOD_NAME As String = "pasteData"
    '------------------------------------------------------------------------------------------------------
    Dim arr As Variant
    Dim wks As Excel.Worksheet
    Dim rng As Excel.Range
    '------------------------------------------------------------------------------------------------------
    Dim firstRow As Long
    Dim firstCol As Long
    Dim lastRow As Long
    Dim lastCol As Long
    '------------------------------------------------------------------------------------------------------

    
    'Check if the given initial range is valid. If not, method cannot continue and code jumps to --------|
    'the label InvalidRangeException.                                                                   '|
    If Not isRangeValid(initRange) Then GoTo InvalidRangeException                                      '|
    '----------------------------------------------------------------------------------------------------|
    
    
    'Only 2D arrays can be printed by this function, so if the given array has only one dimension -------|
    'convert it to 2D. It can be done by using function to2DArray (for 2D arrays this function          '|
    'made no modifications to the source array).                                                        '|
    arr = to2DArray(data)                                                                               '|
    '----------------------------------------------------------------------------------------------------|
    
    
    'Check if the array returned by the function to2DArray has in fact two dimensions. It must be -------|
    'checked since this function returns empty value if a source array is not defined yet or has more   '|
    'than two dimensions.                                                                               '|
    If countDimensions(arr) <> 2 Then GoTo IllegalDataFormat                                            '|
    '----------------------------------------------------------------------------------------------------|
    
    
    'Function reaches this point only if variable [arr] has been successfully converted to 2D array. ----|
    With initRange                                                                                      '|
                                                                                                        '|
        'Set the reference to the Excel worksheet and unprotect it in order to paste data. ----------|  '|
        Set wks = .parent                                                                           '|  '|
        Call wks.Unprotect                                                                          '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
        'Clear the content of the worksheet if [clearSheet] parameter is set to True. ---------------|  '|
        If clearSheet Then Call wks.Cells.clearContents                                             '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
        'Transpone the data array if [transponeData] parameter is set to True. ----------------------|  '|
        If transponeData Then arr = transposeArray(arr)                                             '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
        'Calculate the destination range of the given data ... --------------------------------------|  '|
        firstRow = .row                                                                             '|  '|
        firstCol = .column                                                                          '|  '|
        lastRow = .row + arraySize(arr, 1) - 1                                                      '|  '|
        lastCol = .column + arraySize(arr, 2) - 1                                                   '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
                                                                                                        '|
    End With                                                                                            '|
    '----------------------------------------------------------------------------------------------------|
        
        
    '... and paste them into this range. ----------------------------------------------------------------|
    With wks                                                                                            '|
        Set rng = .Range(.Cells(firstRow, firstCol), .Cells(lastRow, lastCol))                          '|
    End With                                                                                            '|
    rng = arr                                                                                           '|
    '----------------------------------------------------------------------------------------------------|



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

'----------------------------------------------------------------------------------------------------------
InvalidRangeException:
    'Error handling for the case if the given range is not valid and cannot be referred.
    GoTo ExitPoint


IllegalDataFormat:
    'Error handling for the case if the given data array is not 2D array and cannot be converted to 2D
    'array.
    GoTo ExitPoint

End Sub






'**********************************************************************************************************
' Name:                 isRangeValid
' Author:               mielk | 2013-04-26
'
' Comment:              Function to check if the given Excel range is valid and you can refer to its
'                       properties and methods without errors.
'
'                       Using this function is very helpful since it lets you avoid
'                       Run-time error '-2147221080 (800401a8)': Automation error.
'                       This error is generated, when the code tries to refer to a property or a method
'                       of an Excel range that had been already closed.
'
' Parameters:
'   rng                 The Excel range to be checked.
'
' Returns:
'   Boolean             True - if the given range is valid and you can refer to it without any errors.
'                       False - if the given range is invalid, that means it is corrupted or had been
'                               closed or deleted before this method has been called and referring to it
'                               will raise an error.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-04-26        mielk           Function created.
'**********************************************************************************************************
Public Function isRangeValid(rng As Excel.Range) As Boolean
    Const METHOD_NAME As String = "isRangeValid"
    '------------------------------------------------------------------------------------------------------
    Dim lngRangeRow As Long
    '------------------------------------------------------------------------------------------------------
    
    On Error Resume Next
    lngRangeRow = rng.row
    
    'Check method is very easy - if the row of the given range has been assigned to the variable
    '[lngRangeRow], this range is valid and you can refer to it. Otherwise, error would be generated
    'and step [lngRangeRow = rng.row] would be skipped because of [On Error Resume Next] statement above.
    If lngRangeRow > 0 Then isRangeValid = True
    
    
End Function






'**********************************************************************************************************
' Name:                 to2DArray
' Author:               mielk | 2013-04-26
'
' Comment:              Method to convert the given value (primitive, object or 1D array) into 2D array.
'
' Parameters:
'   value               Value or array of values to be converted into 2D array.
'
'
' Returns:
'   Variant             Two-dimensional array containing data given as a parameter.
'                       * If primitive value or object is given to this function, the result will be
'                         2D array with one row and one column and source value inserted as content of
'                         the only cell of this array.
'                       * If 1D array is given to this function, the result will be 2D array with one
'                         column and as many rows as the source array. All the values from the original
'                         array will be copied into result array.
'                       * If 2D array is given to this function, the result will be the same array without
'                         any modification.
'                       * If dynamic array not initialized yet is given as a parameter, it will be returned
'                         without any modifications.
'                       * If any other value is given to this function, exception will be thrown.
'
'
' Exceptions:
'   TooManyDimensionsException      Thrown if the given parameter is an array having more than two
'                                   dimensions.
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-04-26        mielk           Method created.
'**********************************************************************************************************
Public Function to2DArray(value As Variant) As Variant
    Const METHOD_NAME As String = "to2DArray"
    '------------------------------------------------------------------------------------------------------
    Dim arr As Variant
    Dim lngRow As Long
    Dim lngLBound As Long
    Dim lngUBound As Long
    '------------------------------------------------------------------------------------------------------
    
    
    'Logic for converting value to 2D array is different for arrays and non-arrays, so first it must ----|
    'checked if this value is an array.                                                                 '|
    If VBA.IsArray(value) Then                                                                          '|
                                                                                                        '|
        'Different methods should be invoked for different number of dimensions in original ---------|  '|
        'array, so the function check how many dimensions has the source array and direct the       '|  '|
        'code into the proper logic.                                                                '|  '|
        Select Case countDimensions(value)                                                          '|  '|
                                                                                                    '|  '|
            'Converting 1D array into 2D. -------------------------------------------------------|  '|  '|
            Case 1:                                                                             '|  '|  '|
                ReDim arr(1 To 1, 1 To UBound(value) - LBound(value) + 1)                       '|  '|  '|
                lngLBound = LBound(value)                                                       '|  '|  '|
                lngUBound = UBound(value)                                                       '|  '|  '|
                                                                                                '|  '|  '|
                '----------------------------------------------------------------------------|  '|  '|  '|
               For lngRow = lngLBound To lngUBound                                          '|  '|  '|  '|
                    If VBA.IsObject(value(lngRow)) Then                                     '|  '|  '|  '|
                        Set arr(1, lngRow - lngLBound + 1) = value(lngRow)                  '|  '|  '|  '|
                    Else                                                                    '|  '|  '|  '|
                        arr(1, lngRow - lngLBound + 1) = value(lngRow)                      '|  '|  '|  '|
                    End If                                                                  '|  '|  '|  '|
                Next lngRow                                                                 '|  '|  '|  '|
                '-- [For lngRow = lngLBound To lngUBound] -----------------------------------|  '|  '|  '|
                                                                                                '|  '|  '|
            '------ [Case 1:] -------------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
                                                                                                    '|  '|
            'Not-defined arrays (0 dimensions) and 2D arrays should be returned without any -----|  '|  '|
            'modification, so just assign the original value to the variable [arr].             '|  '|  '|
            Case 0, 2:          arr = value                                                     '|  '|  '|
            '------ [Case 0, 2:] ----------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
                                                                                                    '|  '|
            'If original array has more than 2 dimensions, TooManyDimensionsException should ----|  '|  '|
            'be generated.                                                                      '|  '|  '|
            Case Else:          GoTo TooManyDimensionsException                                 '|  '|  '|
            '------ [Case 0, 2:] ----------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
        End Select                                                                                  '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
    Else                                                                                                '|
                                                                                                        '|
        '--- [value] is a single object or a primitive value. ---------------------------------------|  '|
        ReDim arr(1 To 1, 1 To 1)                                                                   '|  '|
                                                                                                    '|  '|
        'Before inserting source value into result array , the function must check if it is -----|  '|  '|
        'object or not, because different assigning statement is used in both those cases.      '|  '|  '|
        If VBA.IsObject(value) Then                                                             '|  '|  '|
            Set arr(1, 1) = value                                                               '|  '|  '|
        Else                                                                                    '|  '|  '|
            arr(1, 1) = value                                                                   '|  '|  '|
        End If                                                                                  '|  '|  '|
        '---------- [If VBA.IsObject(arr(i)) Then] ----------------------------------------------|  '|  '|
                                                                                                    '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    End If                                                                                              '|
    '-------------- [If VBA.IsArray(value) Then] --------------------------------------------------------|
    

    to2DArray = arr


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

'----------------------------------------------------------------------------------------------------------
TooManyDimensionsException:
    'Error handling for the case if the original value is an array having more than 2 dimensions.
    'Call Err.Raise(Number:=ERR_DIMENSIONS, Source:=METHOD_NAME, _
                    Description:="Given array has too many dimensions")
    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









'**********************************************************************************************************
' 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:                 arraySize
' Author:               mielk | 2014-07-15
'
' Comment:              Function returns the size of the specified dimension of the given array.
'
' Parameters:
'   arr                 Array which size is to be returned.
'   dimension           Dimension for which the size is to be returned.
'                       This parameter is optional. If it is skipped, the size of first dimension will
'                       be returned.
'
'
' Returns:
'   Long                Size of the given array in the specified dimension.
'
'                       Examples:
'                       -----------------------------------------------------------------------------------
'
'
'
' Exceptions:
'   NotArrayException               Thrown if the given parameter [arr] is not an array.
'   NotDefinedArrayException        Thrown if the given paremeter [arr] is an array, but it has not been
'                                   initialized yet.
'   IndexOutOfBoundException        Thrown if the parameter [dimension] exceeds the number of dimensions
'                                   in the given base array [arr].
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2014-07-15        mielk           Method created.
'**********************************************************************************************************
Public Function arraySize(arr As Variant, Optional dimension As Integer = 1) As Long
    Const METHOD_NAME As String = "arraySize"
    '------------------------------------------------------------------------------------------------------
    
    
    'Check if the given parameter [arr] is an array and if it has been already initialized. -------------|
    'If it is not an array, code is moved to the label NotArrayException.                               '|
    'If it is an array, but has not been initialized yet, code is moved to the label                    '|
    'NotDefinedArrayException.                                                                          '|
    If Not VBA.IsArray(arr) Then GoTo NotArrayException                                                 '|
    If Not isDefinedArray(arr) Then GoTo NotDefinedArrayException                                       '|
    '----------------------------------------------------------------------------------------------------|


    'Compare parameter [dimension] with the number of dimensions in the given array [arr]. If it is -----|
    'greater than the number of dimensions, IndexOutOfBoundException is thrown.                         '|
    If dimension > countDimensions(arr) Then GoTo IndexOutOfBoundException                              '|
    '----------------------------------------------------------------------------------------------------|


    'Calculate the size of the given array in the given dimension. --------------------------------------|
    arraySize = UBound(arr, dimension) - LBound(arr, dimension) + 1                                     '|
    '----------------------------------------------------------------------------------------------------|


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


'----------------------------------------------------------------------------------------------------------
NotArrayException:
    'Error handling for the case if the given parameter [arr] is not an array.
    GoTo ExitPoint


NotDefinedArrayException:
    'Error handling for the case if the given parameter [arr] is an array but it has not been
    'initialized yet.
    GoTo ExitPoint
    

IndexOutOfBoundException:
    'Error handling for the case if the given dimension exceeds the number of dimensions in the given
    'array [arr]
    GoTo ExitPoint


End Function