Since function sortArray1D 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
'**********************************************************************************************************
' Name: sortArray1D
' Author: mielk | 2013-04-26
'
' Comment: Method to sort the given 1D array in the specified order.
'
' Parameters:
' arr 1D array to be sorted.
' ascending Optional parameter of Boolean type.
' It determines if the array should be sorted in ascending order. By default arrays
' are sorted in ascending order.
'
'
' Exceptions:
' NotArrayException Thrown if the given parameter is not an array.
' TooManyDimensionsException Thrown if the given array has more than one dimension.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-04-26 mielk Method created.
'**********************************************************************************************************
Public Sub sortArray1D(arr As Variant, Optional ascending As Boolean = True)
Const METHOD_NAME As String = "sortArray1D"
'------------------------------------------------------------------------------------------------------
Dim arrGreater() As Variant
Dim arrLower() As Variant
Dim varBaseValue As Variant
Dim lngLBound As Long
Dim lngUBound As Long
Dim lngRow As Long
Dim lngLowerCount As Long
Dim lngGreaterCount As Long
'------------------------------------------------------------------------------------------------------
'Check if the given parameter is an array and if it has only one dimension. -------------------------|
If Not VBA.IsArray(arr) Then GoTo NotArrayException '|
If countDimensions(arr) <> 1 Then GoTo TooManyDimensionsException '|
'----------------------------------------------------------------------------------------------------|
'Work out bounds of the given array. '---------------------------------------------------------------|
lngLBound = LBound(arr, 1) '|
lngUBound = UBound(arr, 1) '|
'----------------------------------------------------------------------------------------------------|
'If up bound of the given array is lower than or equal to the low bound of the same array, '---------|
'it means this array has only one element or has not elements at all. In both those cases '|
'there is no point to sort it. '|
If lngUBound <= lngLBound Then GoTo NothingToSort '|
'----------------------------------------------------------------------------------------------------|
'Resize the temporary arrays to make them capable to store all elements of the source array. --------|
ReDim Preserve arrLower(1 To lngUBound - lngLBound) '|
ReDim Preserve arrGreater(1 To lngUBound - lngLBound) '|
'----------------------------------------------------------------------------------------------------|
'Each element of the source array is being compared to the base value (in fact - the first ----------|
'element in the source array) and added to the proper subarray, depending on if it is '|
'greater or lower than the base value. '|
If lngUBound - lngLBound > 0 Then '|
'|
'--------------------------------------------------------------------------------------------| '|
For lngRow = lngLBound + 1 To lngUBound '| '|
'| '|
'------------------------------------------------------------------------------------| '| '|
If arr(lngRow) < arr(1) Then '| '| '|
lngLowerCount = lngLowerCount + 1 '| '| '|
arrLower(lngLowerCount) = arr(lngRow) '| '| '|
Else '| '| '|
lngGreaterCount = lngGreaterCount + 1 '| '| '|
arrGreater(lngGreaterCount) = arr(lngRow) '| '| '|
End If '| '| '|
'------------------------------------------------------------------------------------| '| '|
'| '|
Next lngRow '| '|
'--------------------------------------------------------------------------------------------| '|
'|
'|
'If there are any items in the temporary [arrLower] array - sort them by the same rules. ----| '|
If lngLowerCount Then '| '|
ReDim Preserve arrLower(1 To lngLowerCount) '| '|
If lngLowerCount > 1 Then Call sortArray1D(arrLower, ascending) '| '|
End If '| '|
'--------------------------------------------------------------------------------------------| '|
'|
'If there are any items in the temporary [arrGreater] array - sort them by the same rules. --| '|
If lngGreaterCount Then '| '|
ReDim Preserve arrGreater(1 To lngGreaterCount) '| '|
If lngGreaterCount > 1 Then Call sortArray1D(arrGreater, ascending) '| '|
End If '| '|
'--------------------------------------------------------------------------------------------| '|
'|
End If '|
'----------------------------------------------------------------------------------------------------|
'At this point values have been already sorted by recurrentive calls of this function. --------------|
'Now they are being added to the final array. '|
varBaseValue = arr(lngLBound) '|
lngRow = lngLBound '|
'|
'If array should be sorted in ascending order, first items from [arrLower] array must be --------| '|
'inserted into final array. For descending order, first items from [arrGreater] are added. '| '|
If ascending Then '| '|
Call sortArray1D_insert(arr, arrLower, lngLowerCount, lngRow) '| '|
Else '| '|
Call sortArray1D_insert(arr, arrGreater, lngGreaterCount, lngRow) '| '|
End If '| '|
'------------------------------------------------------------------------------------------------| '|
'|
arr(lngRow) = varBaseValue '|
lngRow = lngRow + 1 '|
'|
'If array is to be sorted in ascending order, items from [arrGreater] temporary subarray are ----| '|
'added as last ones. For descending order, items from [arrLower] are added at the end. '| '|
If ascending Then '| '|
Call sortArray1D_insert(arr, arrGreater, lngGreaterCount, lngRow) '| '|
Else '| '|
Call sortArray1D_insert(arr, arrLower, lngLowerCount, lngRow) '| '|
End If '| '|
'------------------------------------------------------------------------------------------------| '|
'|
'----------------------------------------------------------------------------------------------------|
'==========================================================================================================
ExitPoint:
Exit Sub
'----------------------------------------------------------------------------------------------------------
NotArrayException:
'(...)
'Put your own error handling here for a case if the given parameter is not an array.
GoTo ExitPoint
TooManyDimensionsException:
'(...)
'Put your own error handling here for a case if the given array has more than one dimension.
GoTo ExitPoint
NothingToSort:
'The given array has only one element or has not elements at all. There is no point to sort it, so
'leave this functions without altering the source array.
GoTo ExitPoint
End Sub
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
'**********************************************************************************************************
' Name: sortArray1D_insert
' Author: mielk | 2013-04-26
'
' Comment: Subfunction used to insert values already sorted into the final array.
'
' Parameters:
' arr Final array.
' tempArray Temporary array which items are to be added to the final array.
' lngItems The number of items in the temporary array.
' lngRow The index of a row where adding items should start.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-04-26 mielk Method created.
'**********************************************************************************************************
Private Sub sortArray1D_insert(arr As Variant, tempArray() As Variant, lngItems As Long, lngRow As Long)
Const METHOD_NAME As String = "sortArray1D_insert"
'------------------------------------------------------------------------------------------------------
Dim jRow As Long
'------------------------------------------------------------------------------------------------------
'If there are any items in the given subarray ... ---------------------------------------------------|
If lngItems Then '|
'|
'... iterate through them and add them to the final array [arr]. ----------------------------| '|
For jRow = 1 To lngItems '| '|
arr(lngRow) = tempArray(jRow) '| '|
lngRow = lngRow + 1 '| '|
Next jRow '| '|
'--------------------------------------------------------------------------------------------| '|
'|
End If '|
'----------------------------------------------------------------------------------------------------|
'Temporary array is not needed anymore so erase it to release memory.
Erase tempArray
End Sub