'********************************************************************************************************** ' Name: getArrayHeadersAsDictionary ' Author: mielk | 2014-09-20 ' ' Description: Function to create a dictionary with mapping of the given array's columns. ' Column header text is the key in the result dictionary and its index number is ' the value. ' ' Parameters: ' arr Array which columns are to be returned. ' It must have two dimensions, it the given array has more or less dimensions, or ' if it is not an array at all, exception will be thrown. ' ' ' 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. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2014-09-20 mielk Function created. '********************************************************************************************************** Public Function getArrayHeadersAsDictionary(arr As Variant) As Object Const METHOD_NAME As String = "getArrayHeadersAsDictionary" '------------------------------------------------------------------------------------------------------ Dim column As Long '------------------------------------------------------------------------------------------------------ 'Check if the given parameter [arr] is an array, if it has been already initialized and -------------| 'if it has exactly two dimensions. '| '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 '| '----------------------------------------------------------------------------------------------------| 'Create new instance of Dictionary and set it searching mode as case insensitive. -------------------| Set getArrayHeadersAsDictionary = VBA.CreateObject("Scripting.Dictionary") '| getArrayHeadersAsDictionary.CompareMode = TextCompare '| '----------------------------------------------------------------------------------------------------| 'Iterate through all the columns in the given array and put their names and index numbers to --------| 'the final Dictionary. '| For column = LBound(arr, 1) To UBound(arr, 1) '| With getArrayHeadersAsDictionary '| If Not .Exists(arr(column, 1)) Then '| Call .add(arr(column, 1), column) '| End If '| End With '| Next column '| '----------------------------------------------------------------------------------------------------| '========================================================================================================== 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 case if the given parameter is an array but it has more than 2 dimensions. 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