Populate a Listbox with Unique data of filtered range

hi,
i am using below code to populate data with unique data of range f10:f1000

Private Sub UserForm_Initialize()

    Dim arrUnqItems As Variant

    With Sheets("SHEET1")
        .Range("F10", .Cells(.Rows.Count, "F").End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
        arrUnqItems = Application.Transpose(.Range(.Cells(2, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp)).Value)
        .Columns(.Columns.Count).Clear
    End With

    Me.ListBox1.Clear
    Me.ListBox1.List = arrUnqItems

    Erase arrUnqItems

End Sub

i want to change above code to apply at filtered data

i want to show unique values of filtered data only

thank you

From what I see the listbox already shows only unique values?

HaroonSid,

If what you mean is you only want to see unique values on the sheet, then add

.Range("F9", .Cells(.Rows.Count, "F").End(xlUp)).AdvancedFilter xlFilterInPlace, unique:=True

just before the "End With" line in the userform initialize code

If you want the listbox click code to only select visible cells too, I would suggest this

Private Sub ListBox1_Click()
    With ListBox1
        Sheets("SHEET1").Range(.List(.ListIndex, 1)).Select
    End With
End Sub

Private Sub UserForm_Initialize()

    Dim arrUnqItems As Variant
    Dim data As Range

    With Sheets("SHEET1")
        Set data = .Range("F10", .Cells(.Rows.Count, "F").End(xlUp))
    End With

    With Me.ListBox1
        .ColumnCount = 2
        .ColumnWidths = ";0"
        .List = UniqueData(data)
    End With

End Sub

Function UniqueData(ByVal dataRange As Range)
    Dim cell As Range
    Dim d As Object
    Dim x As Long
    On Error Resume Next
    Set dataRange = dataRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not dataRange Is Nothing Then
        Set d = CreateObject("scripting.dictionary")
        For Each cell In dataRange.Cells
            If Not d.exists(cell.Value) Then d(cell.Value) = cell.Address
        Next
        UniqueData = Application.Transpose(Array(d.keys, d.items))
    End If
    
End Function

@ xlnitwit
Thank you very very much

best regards
Mohd Haroon