Since function addColumns 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
'**********************************************************************************************************
' Name: addColumns
' Author: mielk | 2014-09-11
'
' Description: Function to add the specified number of columns to the given array.
'
' Parameters:
' arr Source array.
' It must have exactly two dimensions, if other array or non-array is given to this
' function, exception will be thrown.
' howManyColumns The number of columns to be added.
' startIndex Optional parameter of Integer type.
' * It defines at what index new columns should be put into the source array.
' * If the number of start index is greater than the total number of columns in the
' source array, new columns are added at the end of the source array.
' * If 0 is passed as [startIndex], columns are added at the beginning of the source
' array.
' * If negative value is given, columns are counted from the end of the source array,
' i.e. if you give -2 as [startIndex] parameter, new rows will be added after the
' second column from the end.
' * If negative index is passed to the function and its absolute value exceeds the
' total number of columns in the source array, new columns are added at the
' beginning of the source array.
' Default value for this parameter is -1, that means new columns will be added
' at the end of the source array.
'
'
' Returns:
' Variant Source array with as many additional column as parameter [howManyColumns] added
' at the index defined in [startIndex] parameter.
'
'
'
' 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 array passed to this function has less or more than two
' dimensions (only 2D arrays can be filtered by this function).
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2014-09-11 mielk Function created.
'**********************************************************************************************************
Public Function addColumns(arr As Variant, howManyColumns As Integer, _
Optional ByVal startIndex As Integer = 1) As Variant
Const METHOD_NAME As String = "addColumns"
'------------------------------------------------------------------------------------------------------
Dim results() As Variant
Dim row As Long
Dim sourceColumnsCounter As Integer
Dim originalColumn As Long
Dim destinationColumn As Long
'------------------------------------------------------------------------------------------------------
'Resize the result array to the proper size (it must have as many rows as the original array and ----|
'n more columns, where n is equal to [startIndex] parameter). '|
ReDim results(LBound(arr, 1) To UBound(arr, 1) + howManyColumns, LBound(arr, 2) To UBound(arr, 2)) '|
'----------------------------------------------------------------------------------------------------|
'Find the proper value of startIndex (it can not excess the total number of columns in the array). --|
sourceColumnsCounter = arraySize(arr, 1) '|
'|
If VBA.Sgn(startIndex) = -1 Then '|
'|
'--------------------------------------------------------------------------------------------| '|
If VBA.Abs(startIndex) > sourceColumnsCounter Then '| '|
startIndex = 0 '| '|
Else '| '|
startIndex = sourceColumnsCounter + startIndex + 1 '| '|
End If '| '|
'--------------------------------------------------------------------------------------------| '|
'|
Else '|
'|
If startIndex > sourceColumnsCounter Then startIndex = sourceColumnsCounter '|
'|
End If '|
'----------------------------------------------------------------------------------------------------|
'Iterate through all the items from the source array and populate the result array with the same ----|
'values. '|
For originalColumn = LBound(arr, 1) To UBound(arr, 1) '|
'|
'--------------------------------------------------------------------------------------------| '|
For row = LBound(arr, 2) To UBound(arr, 2) '| '|
'| '|
destinationColumn = VBA.IIf(originalColumn > startIndex, _
originalColumn + howManyColumns, originalColumn) '| '|
Call assign(results(destinationColumn, row), arr(originalColumn, row)) '| '|
'| '|
Next row '| '|
'--------------------------------------------------------------------------------------------| '|
'|
Next originalColumn '|
'----------------------------------------------------------------------------------------------------|
addColumns = results
'==========================================================================================================
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
DimensionsException:
'Error handling for the case when the number of dimensions of the array passed to this function
'is different than 2 ...
GoTo ExitPoint
End Function