Copy Unique Distinct Values

Hi,

I have a worksheet (ItemsWithDupes) of over 3900 items which includes hundreds of duplicates. I want to copy unique distinct items to another worksheet (ItemsNoDupes). Here is the code I have but it does not seem to work.

Note: the starting locations (C8 on the source worksheet and A8 on the result worksheet) are the same as on the whole workbook.

Private Sub Worksheet_Activate()

    Dim a, i As Long
    Dim dic As Object
    Dim n As Long
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Sheets("ItemsWithDupes")
        a = .Range("c8", .Range("c" & Rows.Count).End(xlUp)).Value
    End With
    For i = 1 To UBound(a, 1)
        If Not dic.exists(a(i, 1)) Then
            n = n + 1
            a(n, 1) = a(i, 1)
            dic(a(i, 1)) = Empty
        End If
    Next

    With Me
        'Makes n the larger of the number of cells in column A or the size of the dictionary
        n = WorksheetFunction.Max(.Cells(UBound(a, 1) - 7, "A"), .Cells(.Rows.Count, "A").End(xlUp).Row)
        
        With .Range(.Cells(8, "A"), .Cells(n, "A"))
            'Clears contents of column A from row 8 to row n
            .ClearContents
            'Resets n to be the size of the dictionary
            n = UBound(a, 1) - 7
            .Value = a
            .Sort Key1:=.Cells(1), Order1:=1, Header:=xlYes
        End With
    End With

End Sub

Would you kindly check my code for what I have done wrong?

Thanks!

UniqueItems.xlsm

1) Delete

       'Makes n the larger of the number of cells in column A or the size of the dictionary
        n = WorksheetFunction.Max(.Cells(UBound(a, 1) - 7, "A"), .Cells(.Rows.Count, "A").End(xlUp).Row)

2) change

With .Range(.Cells(8, "A"), .Cells(n, "A"))

to

With .Range("a8").resize(n)

Thanks, jindon; that works perfectly!