Since function removeColumns 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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
'**********************************************************************************************************
' Name: removeColumns
' Author: mielk | 2014-09-20
'
' Description: Function to remove the columns with the specified index from the given array.
'
' Parameters:
' arr Array to be processed.
' It must have two dimensions. If the given array has more or less dimensions, or
' if it is not an array at all, exception will be thrown.
' columnsToBeRemoved Parameter to define which columns should be removed from the source array.
' * It is parameter of ParamArray type, that means it is possible to pass
' custom numbers of values (up to 30) or none values at all.
' * There are two ways to define column to be removed:
' - by giving its index number (it cannot be lower than the minimum column index
' nor greater than the maximum column index in the source array, otherwise it
' will be ignored),
' - by giving header of the column to be removed (if the header fiven by user is
' not found in the source array, it will be ignored).
' * Values of any type other than String or Numeric are ignored.
'
'
' Returns:
' Variant() The source array without the columns defined in [columnsToBeRemoved] parameter.
'
'
' 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.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2014-09-20 mielk Function created.
'**********************************************************************************************************
Public Function removeColumns(arr As Variant, ParamArray columnsToBeRemoved() As Variant) As Variant
Const METHOD_NAME As String = "removeColumns"
'------------------------------------------------------------------------------------------------------
Dim varCol As Variant 'Value to iterate through the param array.
Dim dictHeaders As Object 'Dictionary of headers extracted from the source array.
Dim dictColumns As Object 'Late binding that allows to use the function, even if
'Microsoft Scripting Runtime library is not loaded.
Dim header As String
Dim index As Long
'------------------------------------------------------------------------------------------------------
Dim columnsCounter As Integer
Dim results() As Variant
Dim row As Long
Dim col As Long
Dim resultColumn As Long
'------------------------------------------------------------------------------------------------------
'Check if the given parameter [arr] is the proper array, 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 jumps to NotDefinedArrayException label. '|
'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 '|
'----------------------------------------------------------------------------------------------------|
'Extract the columns to be removed and put them into Dictionary. ------------------------------------|
'All string values are converted to the index number when the header is found. If there is no '|
'such header in the source array, this value is ignored. '|
'|
Set dictColumns = VBA.CreateObject("Scripting.Dictionary") '|
'|
For Each varCol In columnsToBeRemoved '|
'|
'Check if the current value is numeric. All non-numeric values are considered to be ---------| '|
'column header and function should find its index in the source array. '| '|
If VBA.IsNumeric(varCol) Then '| '|
'| '|
'For column defined by index, function needs to check if they don't exceed ----------| '| '|
'array columns range. '| '| '|
If varCol >= LBound(arr, 1) And varCol <= UBound(arr, 1) Then '| '| '|
'| '| '|
index = VBA.CLng(varCol) '| '| '|
'| '| '|
End If '| '| '|
'------- [If varCol >= LBound(arr, 1) And varCol <= UBound(arr, 1) Then] ------------| '| '|
'| '|
Else '| '|
'| '|
header = stringify(varCol) '| '|
'| '|
'| '|
'Only non empty headers are being searched in the source array. ---------------------| '| '|
If isNonEmptyString(header) Then '| '| '|
'| '| '|
'Extracting source array headers is initialized only when the first --------| '| '| '|
'non-numeric item is found. There is no point to do that, if there are '| '| '| '|
'only numeric column index given in the parameter. '| '| '| '|
If dictHeaders Is Nothing Then '| '| '| '|
Set dictHeaders = getArrayHeadersAsDictionary(arr) '| '| '| '|
End If '| '| '| '|
'----------------------------------------------------------------------------| '| '| '|
'| '| '|
'| '| '|
'Check if there is such header in the source array. -------------------------| '| '| '|
With dictHeaders '| '| '| '|
If .Exists(header) Then '| '| '| '|
index = .item(header) '| '| '| '|
End If '| '| '| '|
End With '| '| '| '|
'----------------------------------------------------------------------------| '| '| '|
'| '| '|
'| '| '|
End If '| '| '|
'------------------------------------------------------------------------------------| '| '|
'| '|
'| '|
End If '| '|
'----------- [If VBA.IsNumeric(varCol) Then] ------------------------------------------------| '|
'|
'|
'Add the index to the dictionary of columns to be removed. ----------------------------------| '|
With dictColumns '| '|
If Not .Exists(index) Then '| '|
Call .add(index, index) '| '|
End If '| '|
End With '| '|
'--- [With dictColumns] ---------------------------------------------------------------------| '|
'|
'|
Next varCol '|
'--------------- [For Each varCol In columnsToBeRemoved] --------------------------------------------|
'Resize the final array to the proper size. ---------------------------------------------------------|
columnsCounter = arraySize(arr, 1) - dictColumns.Count '|
'|
'If all the columns are selected to be removed, empty array is returned. ------------------------| '|
If columnsCounter = 0 Then GoTo RemoveAllColumns '| '|
'------------------------------------------------------------------------------------------------| '|
'|
ReDim results(1 To columnsCounter, LBound(arr, 2) To UBound(arr, 2)) '|
'----------------------------------------------------------------------------------------------------|
'Iterate through all the columns from the original array and append to the final array those --------|
'columns that are not selected to be removed. '|
For col = LBound(arr, 1) To UBound(arr, 1) '|
'|
'Check if this column exists in the dictionary of column to be removed. If not, append ------| '|
'data from this column to the final array. '| '|
If Not dictColumns.Exists(col) Then '| '|
'| '|
resultColumn = resultColumn + 1 '| '|
'| '|
'Iterate through all the cells in this column, and append their values to the -------| '| '|
'final array. '| '| '|
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 '| '| '| '|
'syntex when appending objects and non-objects. '| '| '| '|
If VBA.IsObject(arr(col, row)) Then '| '| '| '|
Set results(resultColumn, row) = arr(col, row) '| '| '| '|
Else '| '| '| '|
results(resultColumn, row) = arr(col, row) '| '| '| '|
End If '| '| '| '|
'-------------- [If VBA.IsObject(value) Then] -------------------------------| '| '| '|
'| '| '|
Next row '| '| '|
'------------------ [For row = LBound(arr, 2) To UBound(arr, 2)] --------------------| '| '|
'| '|
End If '| '|
'---------------------- [If Not dictColumns.Exists(col) Then] -------------------------------| '|
'|
Next col '|
'-------------------------- [For col = LBound(arr, 1) To UBound(arr, 1)] ----------------------------|
'==========================================================================================================
ExitPoint:
'Assign final array to the result of this function.
removeColumns = results
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 case if the given parameter is an array but it has more than 2 dimensions.
GoTo ExitPoint
RemoveAllColumns:
GoTo ExitPoint
End Function