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
'**********************************************************************************************************
' Name: getArrayColumn
' Author: mielk | 2014-07-15
'
' Comment: Function returns the single column from the given 2D array as a 1D array.
'
' Parameters:
' arr Array from which the column is to be extracted.
' It must be 2D array, otherwise exception will be thrown.
' column Index of column to be extracted.
'
'
' Returns:
' Variant() 1D array containing the same values as the specified column from the given array.
'
'
'
' Exceptions:
' NotArrayException Thrown if the given parameter [arr] is not an array.
' NotDefinedArrayException Thrown if the given paremeter [arr] is an array, but it has not been
' initialized yet.
' DimensionsException Thrown if the given array has more or less than 2 dimensions.
' ColumnOutOfRangeException Thrown if the given column by which the array is to be sorted is
' greater than the total number of columns in this array.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2014-07-15 mielk Method created.
'**********************************************************************************************************
Public Function getArrayColumn(arr As Variant, column As Long) As Variant()
Const METHOD_NAME As String = "getArrayColumn"
'------------------------------------------------------------------------------------------------------
Dim result() As Variant
Dim row As Long
'------------------------------------------------------------------------------------------------------
'Check if the given parameter is a proper array. ----------------------------------------------------|
If Not VBA.IsArray(arr) Then GoTo NotArrayException '|
If Not isDefinedArray(arr) Then GoTo NotDefinedArrayException '|
If countDimensions(arr) <> 2 Then GoTo DimensionsException '|
If column < LBound(arr, 1) Or column > UBound(arr, 1) Then GoTo ColumnOutOfRangeException '|
'----------------------------------------------------------------------------------------------------|
'Allocate result array.
ReDim result(1 To arraySize(arr, 2))
'Iterate through all the items of the given array in the specified column and append them to --------|
'the result array. '|
For row = LBound(arr, 2) To UBound(arr, 2) '|
result(row) = arr(column, row) '|
Next row '|
'----------------------------------------------------------------------------------------------------|
'Assign the result array to the result of function.
getArrayColumn = result
'==========================================================================================================
ExitPoint:
Exit Function
'----------------------------------------------------------------------------------------------------------
NotArrayException:
'Error handling for the case if the parameter passed to the function is not an array ...
GoTo ExitPoint
NotDefinedArrayException:
'Error handling for the case if the number of dimensions of the array passed to this function
'is different than 2 ...
GoTo ExitPoint
DimensionsException:
'Error handling for the case if the number of dimensions of the array passed to this function
'is different than 2 ...
GoTo ExitPoint
ColumnOutOfRangeException:
'Error handling for the case if the given column index is greater than the total number of
'columns in this array ...
GoTo ExitPoint
End Function