Find all distinct values in user based selection - Excel VBA

Question

is there a quick and easy way to select all distinct values within a given selection in Excel with VBA?

0 | we | 0
--+----+--
we| 0  | 1

-> the result should be {0,we,1}

Many thanks in advance

Using a Dictionary is superior to a Collection. – brettdj Jan 17 '14 at 10:47 — brettdj, Jan 17 '14 at 10:47

score 2 · Answer 1 · answered Jan 16 '14 at 18:37

2

Give this a try:

Sub Distinct()
    Dim c As Collection
    Set c = New Collection
    Dim r As Range
    Dim dis As Range
    Set dis = Nothing
    For Each r In Selection
        If r.Value <> "" Then
            On Error Resume Next
            c.Add r.Value, CStr(r.Value)
            If Err.Number = 0 Then
                If dis Is Nothing Then
                    Set dis = r
                Else
                    Set dis = Union(dis, r)
                End If
            End If
            Err.Number = 0
            On Error GoTo 0
        End If
    Next r
dis.Select
End Sub

answered Jan 16 '14 at 18:37

Gary's Student

95,722
10
59
99

The code does nothing (nothing happend), where can I see the result? – Tom Stevens Jan 16 '14 at 18:50
@TomStevens Before running this you need to select all the data then after you run it only the distinct selection are going to be selected. – user2140261 Jan 16 '14 at 18:53

score 2 · Answer 2 · edited Nov 29 '15 at 14:09

2

by the way I've found another solution:

Option Explicit

Public Sub Test()
    Dim cell As Object
    Dim d As Object

    Set d = CreateObject("Scripting.Dictionary")    
    For Each cell In Selection
        d(cell.Value) = 1
    Next cell

    MsgBox d.count & " unique item(s) in selection (" & Join(d.Keys, ",") & ")"
End Sub

edited Nov 29 '15 at 14:09

Zev Spitz

13,950
6
64
136

answered Jan 21 '14 at 13:01

Tom Stevens

195
1
1
12

score 1 · Answer 3 · answered Jan 16 '14 at 19:20

An alternative approach would be to create a user function. The following function will return a row-array with all distinct values in a selection.

Function ReturnDistinct(InpRng)
    Dim Cell As Range
    Dim i As Integer
    Dim DistCol As New Collection
    Dim DistArr()

    If TypeName(InpRng) <> "Range" Then Exit Function

    'Add all distinct values to collection
    For Each Cell In InpRng
        On Error Resume Next
        DistCol.Add Cell.Value, CStr(Cell.Value)
        On Error GoTo 0
    Next Cell

    'Write collection to array
    ReDim DistArr(1 To DistCol.Count)
    For i = 1 To DistCol.Count Step 1
        DistArr(i) = DistCol.Item(i)
    Next i

    ReturnDistinct = DistArr
End Function

The code takes advantage of the fact that you can only add distinct values to a collection. Otherwise it will return an error.

By using this function on a range at least big enough to contain the distinct values, it will list the distinct values from the input range. Remember to use Ctrl+Shift+Enter when working with functions that should return a matrix.

enter image description here

Find all distinct values in user based selection - Excel VBA

3 Answers3

Linked