This script prompts the user to select a range, then puts all the unique values from that range into a single column list on a new worksheet

write_uniques_to_new_sheet.vb

Public Sub WriteUniquesToNewSheet()

    Dim wksUniques As Worksheet
    Dim rngUniques As Range, rngTarget As Range
    Dim strPrompt As String
    Dim varUniques As Variant
    Dim lngIdx As Long
    Dim colUniques As Collection
    Set colUniques = New Collection
    
    'Prompt the user to select a range to unique-ify
    strPrompt = "Select the Range from which you'd like to extract uniques"
    On Error Resume Next
        Set rngTarget = Application.InputBox(strPrompt, "Get Range", Type:=8)
    On Error GoTo 0
    If rngTarget Is Nothing Then Exit Sub '<~ in case the user clicks Cancel
    
    'Collect the uniques using the function we just wrote
    Set colUniques = CollectUniques(rngTarget)
    
    'Load a Variant array with the uniques
    '(in preparation for writing them to a new sheet)
    ReDim varUniques(colUniques.Count, 1)
    For lngIdx = 1 To colUniques.Count
        varUniques(lngIdx - 1, 0) = CStr(colUniques(lngIdx))
    Next lngIdx
    
    'Create a new worksheet (where we will store our uniques)
    Set wksUniques = ThisWorkbook.Worksheets.Add
    Set rngUniques = wksUniques.Range("A1:A" & colUniques.Count)
    rngUniques = varUniques
    
    'Let the user know we're done!
    MsgBox "Finished!"
    
End Sub