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
1 | Function GetUniquesFromRange_Coll(SourceRng As Range) As Object |
2 |
3 | ' Late binding, no reference required |
4 | Dim myuniques As Object |
5 | Set myuniques = CreateObject("Scripting.Collection") |
6 | Dim c As Range |
7 | |
8 | ' Check 'SourceRng' is valid |
9 | If SourceRng Is Nothing Then Exit Function |
10 |
11 | ' Add the unique items to collection |
12 | ' .. this works because collections can only hold unique items |
13 | ' .. errors are overcome by 'on error resume next' |
14 | On Error Resume Next |
15 | For Each c In SourceRng |
16 | myuniques.Add c.Value, CStr(c.Value) |
17 | Next c |
18 | On Error GoTo 0 |
19 |
20 | Set GetUniquesFromRange_Coll = myuniques |
21 |
22 | Set myuniques = Nothing |
23 |
24 | End Function |
25 |
26 | Sub HowToUse_GetUniquesFromRange_Coll() |
27 |
28 | Dim oCollection As Object |
29 | Dim x As Variant |
30 | |
31 | Set oCollection = GetUniquesFromRange(ActiveSheet.Range("B2:B123")) |
32 |
33 | For Each x In oCollection |
34 | Debug.Print x |
35 | Next x |
36 |
37 | End Sub |