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