Function GetUniqueValues(sourceRange As Range) As Variant()
    Dim w As Worksheet
    Dim r As Range
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    Set w = Worksheets.Add
    Set r = w.Range("A1")
    sourceRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=r, Unique:=True
    r.CurrentRegion.Sort r, xlAscending
    GetUniqueValues = r.CurrentRegion.Value
    w.Delete
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Function