Since function filterArray 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
'**********************************************************************************************************
' Name: filterArray
' Author: mielk | 2014-08-29
'
' Comment: Function to filter the given 2D array by the specified value in the specified
' column.
'
' Parameters:
' arr The source array.
' It must be 2D array. If the given parameter is not an array or it has more or less
' than two dimensions, the proper exception will be raised.
' column The index number of column by which the source array is to be filtered.
' value The value by which the source array is to be filtered.
' includeMatched Optional parameter of a Boolean type.
' * It defines if the array rows having the specified value in the specified column
' should be included or excluded from the result array.
' * If this value is set to True, only rows having the given value in the specified
' column will be returned.
' * If this value is set to False, the result array contains only rows that have
' other value in the specified column.
' * In fact, function filterArray with parameter [includeMatch] set to False is the
' exact opposite to the same function invoked with parameter [includeMatch] set
' to True.
' Default value for this parameter is True, so if you skip it, only rows with
' matching value in the specified column will be returned.
'
'
'
' Returns:
' Variant() Array containing all the values from the source array that have the given value
' in the specified array (if [includeMatch] parameter is set to True) or all the
' rows having other value in this column (in [includeMatch] parameter is set to
' False).
'
'
'
' Exceptions:
' NotArrayException Thrown if the given parameter is not an array.
' DimensionsException Thrown if the array passed to this function has less or more than two
' dimensions (only 2D arrays can be filtered by this function).
' 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-08-29 mielk Function created.
'**********************************************************************************************************
Public Function filterArray(arr As Variant, column As Integer, value As Variant, _
Optional includeMatched As Boolean = True) As Variant
Const METHOD_NAME As String = "filterArray"
'------------------------------------------------------------------------------------------------------
Dim results() As Variant
Dim row As Long
Dim col As Integer
Dim found As Long
'------------------------------------------------------------------------------------------------------
'Checks if the given parameter [arr] is an array. If not, code --------------------------------------|
'execution moves to the NotArrayException label. '|
If Not isDefinedArray(arr) Then GoTo NotArrayException '|
'----------------------------------------------------------------------------------------------------|
'Only 2-dimensional arrays can be sorted by this function, so check if the array passed -------------|
'as a parameter has exactly two dimensions. If it has less or more dimensions, code execution '|
'moves to the DimensionsException label. '|
If countDimensions(arr) <> 2 Then GoTo DimensionsException '|
'----------------------------------------------------------------------------------------------------|
'Iterate through all the rows of the source array. --------------------------------------------------|
For row = 1 To UBound(arr, 2) '|
'|
'For each row of the source array compare the value in the specified column with the --------| '|
'based value given as a parameter [value]. '| '|
If (arr(column, row) = value) = includeMatched Then '| '|
'| '|
'If this row is to be included in the result, add new row to the result array ... ---| '| '|
found = found + 1 '| '| '|
ReDim Preserve results(LBound(arr, 1) To UBound(arr, 1), 1 To found) '| '| '|
'| '| '|
'... and populate it with the values from the source array. '| '| '|
For col = LBound(arr, 1) To UBound(arr, 1) '| '| '|
results(col, found) = arr(col, row) '| '| '|
Next col '| '| '|
'------------------------------------------------------------------------------------| '| '|
'| '|
End If '| '|
'--------------------------------------------------------------------------------------------| '|
'|
Next row '|
'----------------------------------------------------------------------------------------------------|
'Assign the result array to the result of this function.
filterArray = results
'==========================================================================================================
ExitPoint:
Exit Function
'----------------------------------------------------------------------------------------------------------
NotArrayException:
'Error handling for the case when the parameter passed to the function is not an array ...
GoTo ExitPoint
DimensionsException:
'Error handling for the case when the number of dimensions of the array passed to this function
'is different than 2 ...
GoTo ExitPoint
ColumnOutOfRangeException:
'Error handling for the case when the given column index is greater than the total number of
'columns in this array ...
GoTo ExitPoint
End Function