VBA to only copy unique records from a filter

Ok I know something like this can be done with code like this:
Columns("X:X").AdvancedFilter Action:=xlFilterInPlace, Unique:=True

However the sisuation is slightly more complicated.
So I have a data sheet in which, lets say, column Y holds project names.
In column X there a names of persons who lead the project.

So now I wanted to make a validation in a given cell where a user can choose a project name.
What the macro then should do is filter the list on chosen project.
So far so good, but next step would be that he copies the column with names to a certain position so I then can have the macro create a validation on that list of names.

Still so far this works BUT if a name occurs multiple times I also get the name multiple times in my validation drop-down list.
And that is ofcourse something I do not want.
Hence my question to only get the unique records when he pastes the name column to the position were he should make the validation.

You can use the Collection, Code below is well commented. See if you can work with it. Modify to your needs.

Private Sub NoDupes()
    Const shName As String = "Sheet1"
    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Dim i As Integer, j As Integer
    Dim Swap1, Swap2, Item
    Dim Lastrow As Long
    
'   Find lastrow on Column A
    Lastrow = Worksheets(shName).Cells(Rows.CountLarge, 1).End(xlUp).Row
'   Get items are in Column A
    Set AllCells = Worksheets(shName).Range("A2:A" & Lastrow)
'   The next statement ignores the error caused
'   by attempting to add a duplicate key to the collection.
'   The duplicate is not added - which is just what we want!
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
'       Note: the 2nd argument (key) for the Add method must be a string
    Next Cell

'   Resume normal error handling
    On Error GoTo 0

'   Sort the collection (optional)
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add Swap1, before:=j
                NoDupes.Add Swap2, before:=i
                NoDupes.Remove i + 1
                NoDupes.Remove j + 1
            End If
        Next j
    Next i
    
'   Now due something with the sorted non-duplicated items
    For Each Item In NoDupes
        Debug.Print Item
    Next Item
End Sub

Thanks for this Mike!
However this would I think mean rebuilding my macro and whas hoping for a bit simpler and small solution.
Ofcourse....IF this is possible.....

Can you upload your macro or workbook. It will be easier to see what is going on.

@rpinxt

Need to use code tags when posting codes to the forum. Looking at your code I think it will be easier if you can upload the workbook

sorry about that, fixed that now. However uploading the entire workbook will not be possible as the file contains classified info whitch I can not throw over the www...sorry.
But this is the entire macro for the part that I want.
Only other thing is a list with data about project and a column in which the user per project is defined

---------- Post added at 04:08 PM ---------- Previous post was at 03:56 PM ----------

Anyway...I just found out a method that suites my purpose.
With help of the remove duplicate function in excel 2007 (should have known that option sooner....)
So this small piece of code fixed my problem:

 ActiveSheet.Range("$X$2:$X$700").RemoveDuplicates Columns:=1, Header:= _
        xlNo

I understand, see if this will work. I havent tested but I think will work for you.

Sub Macro3()

On Error GoTo Terminate
Dim UniqueValues As New Collection
Dim AllCells As Range, Cell As Range

    Application.ScreenUpdating = False
    Sheet6.Visible = True
    pj = Range("C4")
    Range("X:X").Clear
    Range("X1") = "Users"
    Sheet6.Select
    ActiveSheet.Range("$A$1:$N$700").AutoFilter Field:=7, Criteria1:=pj
    Range("D2:D100").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheet8.Select
    Range("AB2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'   Find the last used row in a Column
    Dim Lastrow As Long
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, "X").End(xlUp).Row
    End With
    
    Set AllCells = ActiveSheet.Range("X2:X" & Lastrow)
'   The next statement ignores the error caused
'   by attempting to add a duplicate key to the collection.
'   The duplicate is not added - which is just what we want!
    On Error Resume Next
    For Each Cell In AllCells
        UniqueValues.Add Cell.Value, CStr(Cell.Value)
'       Note: the 2nd argument (key) for the Add method must be a string
        Cell.ClearContents
    Next Cell
'   Now due something with the sorted non-duplicated items
    i = 2
    For Each Item In UniqueValues
        Cells(i, "X") = Item
        i = i + 1
    Next Item
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, "X").End(xlUp).Row
    End With
    Rng = "=$X$2:$X$" & Lastrow & ""
    
    Range("C5").Activate
    Selection.UnMerge
    Range("C5").Clear
    Range("C5:G5").Select
    Selection.Merge

       With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Rng
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

'    Sheet6.Visible = False
    Application.ScreenUpdating = True
    Exit Sub
    
Terminate:
    Sheet7.Activate
    MsgBox "Name not in list", vbOKOnly + vbExclamation, "Ending inquiry"
    Range("C5").Activate
    Selection.UnMerge
    Range("C5").Clear
    Range("C4").Activate
    Sheet6.Visible = False
End Sub