Function to extract unique values from a given range.
Uses the vba ‘Dictionary’ and returns a dictionary.
The dictionary method has several benefits over the collection
method and offers greater control. An example is the ‘Exists’
function to test if a specific value is in the dictionary.
Please see the included procedure ‘HowToUse_GetUniquesFromRange_Dict’
Author: michael@excelexperts.co.uk
Function GetUniquesFromRange_Dict(SourceRng As Range) As Object
' Late binding, no reference required
Dim myuniques As Object
Set myuniques = CreateObject("Scripting.Dictionary")
Dim c As Range
' Check 'SourceRng' is valid
If SourceRng Is Nothing Then Exit Function
' Add the unique items to collection
' .. this works because dictionary's can only hold unique items
' .. errors are overcome by 'on error resume next'
On Error Resume Next
For Each c In SourceRng
myuniques.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
Set GetUniquesFromRange_Dict = myuniques
Set myuniques = Nothing
End Function
Sub HowToUse_GetUniquesFromRange_Dict()
' The benefit of using dictionary (as opposed to collection) is
' that you can check, for example, if a unique value exists.
Dim oDict As Object
Dim x As Variant
Dim sKey As String
Set oDict = GetUniquesFromRange_Dict(ActiveSheet.Range("B2:B123"))
For Each x In oDict
Debug.Print x
Next x
sKey = ActiveSheet.Range("B2")
If oDict.exists(sKey) Then Debug.Print "True"
Set oDict = Nothing
End Sub