'********************************************************************************************************** ' Name: isDynamicArray ' Author: mielk | 2012-03-27 ' ' Comment: Checks if a given parameter is a dynamic array. ' Function works properly only on arrays with no more than three dimensions. If an array has ' more than three dimensions, the exception TooManyDimensionsException is thrown. ' ' Parameters: ' arr Array to be tested. ' ' Returns: ' Boolean True - if arr is a dynamic (resizable) array. ' False - if parameter arr is not an array or it is a fixed array. ' ' ' Exceptions: ' TooManyDimensionsException ' Thrown if the given array has more than three dimensions. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2012-03-27 mielk Function created. '********************************************************************************************************** Public Function isDynamicArray(arr As Variant) As Boolean Const METHOD_NAME As String = "isDynamicArray" '------------------------------------------------------------------------------------------------------ 'The following commands are executed only when the given parameter is 'an array. There is no point to check whether a parameter is a 'dynamic array, if it is not array at all. If VBA.IsArray(arr) Then 'Function tries to resize the given array (the use of functions 'LBound and UBound assures that the new dimension is equal to the 'previous one). The trick is that the dimensions of non-dynamic 'arrays are fixed and any attempt to resize them would generate 'an error that causes moving code execution to errHandler label 'and by that fact leaving this function with False value. On Error GoTo StaticArray Select Case countDimensions(arr) Case 0 'If arr is an array but has no dimensions, it has to be 'a dynamic array, since the fixed arrays always have at least 'one dimension. Case 1 If UBound(arr, 1) >= LBound(arr, 1) Then ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1)) End If Case 2 ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1), _ LBound(arr, 2) To UBound(arr, 2)) Case 3 ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1), _ LBound(arr, 2) To UBound(arr, 2), _ LBound(arr, 3) To UBound(arr, 3)) Case Else 'Functions doesn't work for arrays with more than three 'dimensions. In such case the code execution move to the 'label TooManyDimensionsException. GoTo TooManyDimensionsException End Select 'The statement below can be reached only if no error occured when 'trying to resize an array (what is possible only for dynamic 'arrays). isDynamicArray = True End If '========================================================================================================== ExitPoint: Exit Function '---------------------------------------------------------------------------------------------------------- StaticArray: isDynamicArray = False GoTo ExitPoint '---------------------------------------------------------------------------------------------------------- TooManyDimensionsException: '(...) 'Put your own error handling here for a case if the given parameter has too many dimensions '(the function works only for array with up to three 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