'********************************************************************************************************** ' Name: getArrayColumn ' Author: mielk | 2014-09-20 ' ' Description: Function to extract a single column from the given 2D array and return it as ' a 1D array. ' First dimension represents columns, the second dimensions represents rows. ' ' Parameters: ' arr Array which column is to be returned. ' Function works only with 2D arrays. If the parameter [arr] is not an array or if it ' has more or less than two dimensions, a proper exception will be thrown. ' column Index number of a column to be returned. ' preserveRowsIndexation ' Optional parameter of Boolean type. ' * It defines if the result array should have the same rows indexation as the source ' array. ' * If this parameter is set to False, then result array is indexed from 1. ' * Default value of this parameter is False, so if this parameter is skipped, the ' result array is indexed from 1. ' ' ' Returns: ' Dictionary Dictionary with map of the given array's columns. ' As a key column headers texts are used, and their column index numbers are used ' as a value. ' ' ' Exceptions: ' NoArrayException Thrown if parameter [arr] is not an array. ' NotDefinedArrayException Thrown if the given array has not been defined yet. ' TooManyDimensionsException Thrown if the given array has more than 2 dimensions. ' ColumnIndexOutOfBoundException Thrown if the given column index is less than minimum column index or ' greater than the maximum column index in the given source array. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2014-09-20 mielk Function created. '********************************************************************************************************** Public Function getArrayColumn(arr As Variant, column As Long, _ Optional preserveRowsIndexation As Boolean = False) As Variant() Const METHOD_NAME As String = "getArrayHeadersAsDictionary" '------------------------------------------------------------------------------------------------------ Dim result() As Variant Dim row As Long Dim lowBound As Long Dim upBound As Long Dim index As Long '------------------------------------------------------------------------------------------------------ 'Check if the given parameter [arr] is a proper value that can be processed by this function. -------| '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 it is an array, but has less or more than two dimensions, code is moved to the label '| 'TooManyDimensionsException. '| If Not VBA.IsArray(arr) Then GoTo NotArrayException '| If Not isDefinedArray(arr) Then GoTo NotDefinedArrayException '| If countDimensions(arr) <> 2 Then GoTo TooManyDimensionsException '| '----------------------------------------------------------------------------------------------------| 'Check if the given column index is not less than minimum or greater than maximum column ------------| 'index in the source array. '| If column < LBound(arr, 1) Or column > UBound(arr, 1) Then '| GoTo ColumnIndexOutOfBoundException '| End If '| '----------------------------------------------------------------------------------------------------| 'Resize the result array to the proper size. --------------------------------------------------------| If preserveRowsIndexation Then '| lowBound = LBound(arr, 2) '| upBound = UBound(arr, 2) '| Else '| lowBound = 1 '| upBound = arraySize(arr, 2) '| End If '| '| ReDim result(lowBound To upBound) '| '----------------------------------------------------------------------------------------------------| 'Extract a specified column into [result] array. ----------------------------------------------------| index = lowBound '| For row = LBound(arr, 2) To UBound(arr, 2) '| '| 'Before adding value to the array, it has to be checked if the value is an object -----------| '| 'or a primitive value, because there is a difference in appending objects and non-objects. '| '| If VBA.IsObject(arr(column, row)) Then '| '| Set result(index) = arr(column, row) '| '| Else '| '| result(index) = arr(column, row) '| '| End If '| '| '-------------- [If VBA.IsObject(value) Then] -----------------------------------------------| '| '| index = index + 1 '| '| Next row '| '----------------------------------------------------------------------------------------------------| 'Assign final array as the result of this function. getArrayColumn = result '========================================================================================================== 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 TooManyDimensionsException: 'Error-handling for the case if the given parameter is an array but it has more than 2 dimensions. GoTo ExitPoint ColumnIndexOutOfBoundException: 'Error-handling for the case if the given column index is less/greater than the minimum/maximum 'column index in the given source array. 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 '********************************************************************************************************** ' 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