Extract uniques values from a range (Collection method)

Function to extract unique values from a given range.
Uses the vba ‘Collection’ and returns a collection.
Please see the included procedure ‘HowToUse_GetUniquesFromRange_Coll’
Author: michael@excelexperts.co.uk

Function GetUniquesFromRange_Coll(SourceRng As Range) As Object

'   	Late binding, no reference required
    Dim myuniques As Object
    Set myuniques = CreateObject("Scripting.Collection")
    Dim c As Range
    
'   	Check 'SourceRng' is valid
    If SourceRng Is Nothing Then Exit Function

'   	Add the unique items to collection
'   	..  this works because collections 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_Coll = myuniques

    Set myuniques = Nothing

End Function

Sub HowToUse_GetUniquesFromRange_Coll()

    Dim oCollection As Object
    Dim x As Variant
    
    Set oCollection = GetUniquesFromRange(ActiveSheet.Range("B2:B123"))

    For Each x In oCollection
        Debug.Print x
    Next x

End Sub

Address

Brookfield,
55 Heath Drive
Brookwood, Surrey
GU24 0HQ England

Scroll to Top