Since function isDynamicArray
uses some non-built VBA functions, they also must be included in your code for the function to work properly.
Otherwise the following error will occur: Compile error: Sub or Function not defined.
Required functions are listed below. You can get to each function's source code by clicking its name:
When adding the functions above to your VBA project, make sure you haven't done it before. If there are two different public functions with the same name in a single VBA project, the following compilation error is thrown: Compile error: Ambiguous name detected: function_name.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
'**********************************************************************************************************
' 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