Create an array from unique values from column

Question

I found this code in this forumn. I want to copy this unique values into an array

Dim sheetName As String
sheetName = Application.InputBox("Enter Sheet Name")

Sheets(sheetName).Range("E:E").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets(sheetName).Range("O:O"), unique:=True

Answer 1

If you want to cut out the range middleman, you can get the values directly into a 1-dimensional VBA array by using a dictionary to make sure that only unique values are grabbed:

Function UniqueVals(Col As Variant, Optional SheetName As String = "") As Variant
    'Return a 1-based array of the unique values in column Col

    Dim D As Variant, A As Variant, v As Variant
    Dim i As Long, n As Long, k As Long
    Dim ws As Worksheet

    If Len(SheetName) = 0 Then
        Set ws = ActiveSheet
    Else
        Set ws = Sheets(SheetName)
    End If

    n = ws.Cells(Rows.Count, Col).End(xlUp).Row
    ReDim A(1 To n)
    Set D = CreateObject("Scripting.Dictionary")

    For i = 1 To n
        v = ws.Cells(i, Col).Value
        If Not D.Exists(v) Then
            D.Add v, 0
            k = k + 1
            A(k) = k
        End If
    Next i

    ReDim Preserve A(1 To k)
    UniqueVals = A

End Function

For example, UniqueVals("E",sheetName) will return an array consisting of the unique values in column E of sheetName.

Answer 2

Another version, also using a dictionary. It works for me, but I must admit that still don't know how it works (I'm a beginner). I found this code somewhere in Stackoverflow, but can't spot the place.

Dim dU1 As Object, cU1 As Variant, iU1 As Long, lrU As Long
Dim i As Integer

Private Sub Go_Click()
    Set dU1 = CreateObject("Scripting.Dictionary")
    lrU = Cells(Rows.Count, 1).End(xlUp).Row
    cU1 = Range("E1:E" & lrU)
    For iU1 = 1 To UBound(cU1, 1)
        dU1(cU1(iU1, 1)) = 1
    Next iU1

    For i = 0 To dU1.Count - 1
        MsgBox "dU1 has " & dU1.Count & " elements and key#" & i & " is " & dU1.Keys()(i)
    Next
End Sub

Answer 3

Here's another method using VBA's Collection object instead of a dictionary.

Sub Dural()
    Dim sheetName As String
    Dim V As Variant, COL As Collection
    Dim I As Long
    Dim vUniques() As Variant

sheetName = Application.InputBox("Enter Sheet Name")

'Copy all data into variant array
'  This will execute significantly faster than reading directly
'  from the Worksheet range

With Worksheets(sheetName)
    V = .Range(.Cells(1, "E"), .Cells(.Rows.Count, "E").End(xlUp))
End With

'Collect unique values
'Use the key property of the collection object to
'  ensure no duplicates are collected
'  (Trying to assign the same key to two items fails with an error
'  which we ignore)
Set COL = New Collection
On Error Resume Next
For I = 1 To UBound(V, 1)
    COL.Add Item:=V(I, 1), Key:=CStr(V(I, 1))
Next I
On Error GoTo 0

'write collection to variant array
ReDim vUniques(1 To COL.Count)
For I = 1 To COL.Count
    vUniques(I) = COL(I)
Next I

Stop

End Sub