Since function uniqueValues 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
'**********************************************************************************************************
' Name: uniqueValues
' Author: mielk | 2014-08-27
'
' Description: Function to return unique value only from the given 1D array.
'
' Parameters:
' arr Array which unique values are to be returned.
'
' Returns:
' Variant() Array containing unique values from the given 1D array.
' Result array is of Variant type, since base array given as an input
' parameter can store all types of data.
'
'
' Exceptions:
' NotArrayException Thrown if the given parameter is not an array.
' TooManyDimensionsException Thrown if the given array has more than one dimension.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2014-08-27 mielk Function created.
'**********************************************************************************************************
Public Function uniqueValues(arr As Variant) As Variant()
Const METHOD_NAME As String = "uniqueValues"
'------------------------------------------------------------------------------------------------------
Dim result() As Variant
Dim i As Long
Dim dict As Object 'Dictionary
Dim value As Variant
'------------------------------------------------------------------------------------------------------
'Check if the given parameter [arr] is an array and if it has exactly one dimension. ----------------|
If Not VBA.IsArray(arr) Then GoTo NotArrayException '|
If countDimensions(arr) > 1 Then GoTo TooManyDimensionsException '|
'----------------------------------------------------------------------------------------------------|
'Initialize variable [dict] with the empty Dictionary for storing unique values. --------------------|
Set dict = VBA.CreateObject("Scripting.Dictionary") '|
'----------------------------------------------------------------------------------------------------|
'Iterate through all the items of the original array and try to insert them into dictionary ---------|
'[dict]. Before adding item to the dictionary it is checked if it not exists already. If it is '|
'already found in the dictionary, it is being skipped. '|
For i = LBound(arr) To UBound(arr) '|
'|
'Before assigning item from source array [arr] to the variable [value], the function --------| '|
'must check if it is object or not, because different assigning statement is used '| '|
'in both those cases. '| '|
If VBA.IsObject(arr(i)) Then '| '|
Set value = arr(i) '| '|
Else '| '|
value = arr(i) '| '|
End If '| '|
'--------------------------------------------------------------------------------------------| '|
'|
'|
'Check if this value already exists in the dictionary [dict]. If not, it is being -----------| '|
'added. If it already exists, it is being skipped. '| '|
If Not dict.Exists(value) Then '| '|
Call dict.add(value, value) '| '|
End If '| '|
'--------------------------------------------------------------------------------------------| '|
'|
'|
Next i '|
'----------------------------------------------------------------------------------------------------|
'Convert dictionary keys into array using function getDictionaryKeys.
uniqueValues = getDictionaryKeys(dict)
'==========================================================================================================
ExitPoint:
Exit Function
'----------------------------------------------------------------------------------------------------------
NotArrayException:
'Error handler for a case if the given parameter is not an array.
GoTo ExitPoint
TooManyDimensionsException:
'Error handler forPut your own error handling here for a case if the given array has more than one dimension.
GoTo ExitPoint
End Function