Get an array of unique values out from filtered data in Excel VBA

Question

As shown in the image, I want to first filter by column A for "Yes".

The above image shows after the filter and I want to save each unique "ID" in columns B and put them into an array called myArr. Ideally, myArr = [101, 5137, 97] and I would be able to call each value in the array using myArr(1), myArr(2), myArr(3)

Below is the code I had, but there are 2 problems:

my arr doesn't seem to be an actual array
it doesn't print the correct answers 101, 5137, 97. Instead, it only prints out 101, 5137

    With [a1].CurrentRegion
        .AutoFilter 1, "Yes"
        'first create arr which include duplicated data
        arr = .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlVisible)
        'myArr is an array with unique values
        myArr = Application.Unique(arr)
        'print out each value of myArr to check if myArr is correct
        For Each num In myArr
            Debug.Print num
        Next num
        .AutoFilter
    End With

Please give me some ideas on what's wrong with my code above.

score 1 · Answer 1 · answered Sep 10 '21 at 00:59

1

Your code is failing because once you apply the filter, the range is no longer contiguous. Your method will only capture a contiguous range.

Because you are setting the Autofilter value from within your routine, lets just check the values inside of an array, and then add the correct values to a dictionary, which will only accept unique values anyways.

Public Sub testUniqueArray()

    Dim arrTemp As Variant, key As Variant
    Dim dict As Object
    Dim i As Long

    arrTemp = [a1].CurrentRegion.Value
    
    Set dict = CreateObject("Scripting.Dictionary")

    For i = LBound(arrTemp) To UBound(arrTemp)
        If arrTemp(i, 1) = "Yes" Then
            dict(arrTemp(i, 2)) = 1
        End If
    Next i
    
    For Each key In dict.Keys
        Debug.Print key
    Next key
End Sub

answered Sep 10 '21 at 00:59

Jody Highroller

999
5
12

Could you please explain what does this line do `dict(arrTemp(i, 2)) = 1`? – JackeyOL Sep 10 '21 at 01:22
It's a quick way to add a key to the Dictionary without worrying about duplicates. It is actually assigning a value to the dictionary key. When assigning a value, if the key does not exist it will be created. If the key exists the value will be changed. If you were to use the `dict.Add Key:="5137"` method, you would trigger an error if there was already a 5137 key. @JackeyOL – Jody Highroller Sep 10 '21 at 01:32
That's a very clever way, but why do we need to use a dictionary here as we are actually only using the keys but not its values at all. Is that an Excel VBA thing? I'm wondering if there is a simple list that we can use in VBA as we do in other languages? – JackeyOL Sep 11 '21 at 21:12
You don't have to use a dictionary. You could use an array, a collection or a dictionary. In this instance, with you only wanting to keep unique values, I think a dictionary is they easiest way to do so. You may find this post about [collections and dictionaries](https://stackoverflow.com/questions/32479842/comparison-of-dictionary-collections-and-arrays) interesting or useful. @JackeyOL – Jody Highroller Sep 12 '21 at 00:45

score 1 · Answer 2 · answered Sep 10 '21 at 08:11

Unique Values from Filtered Column to Array

Option Explicit

Sub PrintUniqueValues()
    
    Const CriteriaColumn As Long = 1
    Const ValueColumn As Long = 2
    Const CriteriaString As String = "Yes"
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    ' You better improve e.g. by using the worksheet (tab) name...
    'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    'Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    ' ... or by using the code name:
    'Dim ws As Worksheet: Set ws = Sheet1
    
    Application.ScreenUpdating = False
    
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
    
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    rg.AutoFilter CriteriaColumn, CriteriaString
    
    Dim Arr As Variant: Arr = ArrUniqueFromFilteredColumn(rg, ValueColumn)
    
    ws.AutoFilterMode = False
    
    Application.ScreenUpdating = True
    
    If IsEmpty(Arr) Then Exit Sub
    
    ' Either (preferred when dealing with arrays)...
    Dim n As Long
    For n = LBound(Arr) To UBound(Arr)
        Debug.Print Arr(n)
    Next n

    ' ... or:
'    Dim Item As Variant
'    For Each Item In Arr
'        Debug.Print Item
'    Next Item

End Sub

Function ArrUniqueFromFilteredColumn( _
    ByVal rg As Range, _
    ByVal ValueColumn As Long) _
As Variant
    If rg Is Nothing Then Exit Function
    If ValueColumn < 1 Then Exit Function
    If ValueColumn > rg.Columns.Count Then Exit Function
    
    Dim crg As Range
    Set crg = rg.Columns(ValueColumn).Resize(rg.Rows.Count - 1).Offset(1)
    
    Dim CellsCount As Long
    CellsCount = WorksheetFunction.Subtotal(103, crg) ' 103 - CountA
    If CellsCount = 0 Then Exit Function ' no match or only empty cells
    'Debug.Print "CellsCount = " & CellsCount
    
    Dim scrg As Range: Set scrg = crg.SpecialCells(xlCellTypeVisible)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' ignore case
    
    Dim cCell As Range
    Dim Key As Variant
    For Each cCell In scrg.Cells
        Key = cCell.Value
        If Not IsError(Key) Then
            If Len(Key) > 0 Then
                dict(Key) = Empty
                ' The previous line is a short version of:
                'If Not dict.Exists(Key) Then dict.Add Key, Empty
            End If
        End If
    Next cCell
    If dict.Count = 0 Then Exit Function ' only errors and blanks
    'Debug.Print "dict.Count = " & dict.Count
    
    ArrUniqueFromFilteredColumn = dict.Keys
    
End Function

Get an array of unique values out from filtered data in Excel VBA

2 Answers2

Unique Values from Filtered Column to Array