Since function to2DArray 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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
'**********************************************************************************************************
' 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