Populate array with unique values from a filtered column with multiple values

Question

I am trying to populate an array with values from a column in a filtered Excel table.

In this column, the values may appear multiple times, but I need to return unique values, not all occurrences of each value.

Column F
a
a
a
b
c
c
a
b
d

The array would have a variable length and, based on the sample column would have the elements: {a, b, c, d}

The length of the array cannot be fixed because my function works with a filtered table that varies in length. Sometimes there may be only one unique value, other times there might be three.

I need to do this because my array will be used to determine the subject of an e-mail with, "... " & Array.

How do I extract unique values in a column to the array?

user_6248219 · Answer

Use Scripting.Dictionary

You can select all the data from a column with sht.Cells(sht.Rows.Count, "F").End(xlUp).Row and then use a Scripting.Dictionary to find your unique values. Here's the code:

'Main Routine
Sub MyMacro()
    Dim sht As Worksheet
    Dim column As Range
    Dim LastRow As Long
    Dim uniqueValues() As Variant

    Set sht = ActiveSheet 'Set your sheet here

    LastRow = sht.Cells(sht.Rows.Count, "F").End(xlUp).Row
    Set column = Range("F1:F" & LastRow)
    uniqueValues = getUniqueValues(column)
    'Do what you need to do with your values [...]
End Sub

'Return unique values from a Range
Function getUniqueValues(column As Range)
    Dim dict As New Scripting.Dictionary ' requires "Microsoft Scripting Runtime"
    Dim cell As Range

    For Each cell In column
        dict(cell.Value) = "1"
    Next

    'A double Transpose will put your data in an Array() format
    getUniqueValues = Application.Transpose(Application.Transpose(dict.Keys))
End Function

If you don't want to import Microsoft Scripting Runtime, use this code for dict declaration:

    'If you don't want to import Scripting Runtime, use this code
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

Note: This is tested and works perfectly.

I hope this helps.

user_4230409 · Answer

you can use Scripting.Dictionary for such task and xlCellTypeVisible, example:

Sub sometest()
    Dim x As Long, cl As Range
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare

    x = Cells(Rows.Count, "A").End(xlUp).Row

    For Each cl In Range(Cells(2, "A"), Cells(x, "A")).SpecialCells(xlCellTypeVisible)
        If Not dic.exists(cl.Value) Then
            dic.Add cl.Value, Nothing
        End If
    Next cl

    Debug.Print Join(dic.keys, ",")

End Sub

test:

Populate array with unique values from a filtered column with multiple values

2 Answers

Use Scripting.Dictionary