Advanced data filter

found this code seems to work ok put in a new module then run
first pop up window highlight range
second pop up window just select an entire spare column

Sub ListUniqueValues()

 'lists the unique values found in a user-defined range into a
 'user-defined columnar range
 
 Dim SearchRng     As Range
 Dim ResultRng     As Range
 Dim Cel           As Range
 Dim iRow          As Long
 
 Set SearchRng = Application.InputBox("Select search range", _
       "Find Unique Values", Type:=8)
 Do
    Set ResultRng = Application.InputBox("Select results columnar range", _
       "Write Unique Values", Type:=8)
 Loop Until ResultRng.Columns.Count = 1
 
 iRow = 0
 For Each Cel In SearchRng
    If Application.WorksheetFunction.CountIf(ResultRng, Cel.Value) = 0 Then
       'This value doesn't already exist
       iRow = iRow + 1
       If iRow > ResultRng.Rows.Count Then
          MsgBox "Not enough rows in result range to write all unique values", _
                vbwarning, "Run terminated"
          Exit Sub
       Else
          ResultRng(iRow).Value = Cel.Value
       End If
    End If
 Next Cel
 
 'sort result range
 ResultRng.Sort ResultRng
       
End Sub