Since function getArrayColumn 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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
'**********************************************************************************************************
' 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