Extract unique values from filtered column

Hi all

The following works to extract unique values from a column.

But, it does not work for a filtered column. I need to filter a column then get only the remaining unique values.

Can someone suggest how to make this work please.

Sub UniqueValues()
Dim WSOrigin As Worksheet
Dim dic As Object
Dim i As Long
Dim arrRangeArray As Variant
Dim arrDicArray As Variant
    
    'Set sheet variables
    Set WSOrigin = Worksheets("ReportDownload")
    LastRow = WSOrigin.Range("U" & Rows.Count).End(xlUp).Row
    
    'Create a dictionary object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    'Pass the column to an array
    arrRangeArray = WSOrigin.Range("U2:U" & LastRow)
    'Loop
    For i = LBound(arrRangeArray) To UBound(arrRangeArray)
        If arrRangeArray(i, 1) <> "" Then dic(arrRangeArray(i, 1)) = Empty 
    Next i

    'Return uniques
    arrDicArray = dic.keys
    
    'Confirm
    For i = 0 To UBound(arrDicArray)
        Debug.Print arrDicArray(i)
    Next i

End Sub

Cheers

i like to use .autofilter, then you can filter (A) and get unique values with:

Sheets(sheet1).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("BB1"), Unique:=True

The line also copies the unique list to another range(BB)

Thanks for the reply.

I needed the range to go into an array.

I was thinking I could select a complete range of just visible cells, but it seems not to work like that. so I used the dictionary loop to do it. then this is returned to the function.

This is what I did.

Maybe it might help someone.

Function UniqueFilteredRange(strColumnLetter As String) As Variant
'************ Works (Do not mess with this) ************
'Purpose: Returns an array with unique values.
'The array is built by passing in the column letter into a range,
'then loops through each visible cell in that range to create a dictionary of unique items.
Dim dDict As Object, cCell As Range
Dim vCellValue As Variant
Dim rngColumn As Range
Dim i As Integer

    'Set sheet variables
    Set WSOrigin = Worksheets("MySheet")
    LastRow = WSOrigin.Range(strColumnLetter & Rows.Count).End(xlUp).Row
    
    'Set the required range
    Set rngColumn = WSOrigin.Range(strColumnLetter & "2:" & strColumnLetter & LastRow)
    
    'Build dictionary with unique values
    Set dDict = CreateObject("scripting.dictionary")
    For Each cCell In rngColumn.Cells.SpecialCells(xlCellTypeVisible) ' This selects whether to enter into dictionary
       strCellValue = Trim(cCell.Value)
       If Len(strCellValue) > 0 Then
            If Not dDict.Exists(strCellValue) Then dDict.Add strCellValue, 1
       End If
    Next cCell

    'Return uniques to Function
    UniqueFilteredRange = dDict.keys
    

End Function