Extract Unique Values List

[Rajan_Verma]

if you want to Extract Unique Value From a List , you can use this UDF :

Function UniqueList(rng As Range, Pos As Long) As String
    
    Dim List() As String
    Dim cell As Range
    Dim i As Long
    Dim t As Long
    i = 0

    ReDim List(rng.Cells.Count) As String
    For Each cell In rng
        flag = 0
        For t = LBound(List) To UBound(List)
            If cell.Value = List(t) Then
                flag = 1
                Exit For
            End If
        Next
        If flag = 0 Then
            List(i) = cell.Value
            i = i + 1
        End If
    Next
    UniqueList = List(Pos)

End Function

[Rajivalwar]

Hi Rajan,

How would I get list of Uniqe value though its return only single value.

Rajiv

if you want to Extract Unique Value From a List , you can use this UDF :

Function UniqueList(rng As Range, Pos As Long) As String
    
    Dim List() As String
    Dim cell As Range
    Dim i As Long
    Dim t As Long
    i = 0

    ReDim List(rng.Cells.Count) As String
    For Each cell In rng
        flag = 0
        For t = LBound(List) To UBound(List)
            If cell.Value = List(t) Then
                flag = 1
                Exit For
            End If
        Next
        If flag = 0 Then
            List(i) = cell.Value
            i = i + 1
        End If
    Next
    UniqueList = List(Pos)

End Function

[Excel Fox]

You are right Rajiv..... we probably didn't need to have an index in the function. But it can be tweaked to give your result though

Function UniqueList(rng As Range, Optional Pos As String) As Variant
    
    Dim List As Variant
    Dim cell As Range
    Dim i As Long
    Dim t As Long
    Dim flag As Long
    i = 0

    ReDim List(rng.Cells.Count) As Variant
    For Each cell In rng
        flag = 0
        For t = LBound(List) To UBound(List)
            If cell.Value = List(t) Then
                flag = 1
                Exit For
            End If
        Next
        If flag = 0 Then
            List(i) = cell.Value
            i = i + 1
        End If
    Next
    ReDim Preserve List(i - 1)
    If Pos <> "" Then
        UniqueList = List(CLng(Pos))
    Else
        UniqueList = List
    End If
    
End Function
Sub ExampleOfHowToUseIt()

    MsgBox Join(UniqueList(rngRange), ",")'When it's an array
    MsgBox UniqueList(rngRange, 1)'When you've passed the index of the element, it gives just one value
    
End Sub

[Rajan_Verma]

Hi Rajeev,

my function is not an array function, it required an index parameter.. like if you are using this in B1 . you can use that like this :
where A1:A12 is your list

=UniqueList($A$1:$A$12,ROW()-1)

[Rajan_Verma]

Here is an array function also

Function GetUniqueList(rng As Range) As Variant

On Error Resume Next

Dim Arr() As Variant
Dim cell As Range
Dim r as Integer, c As Integer
Dim i as integer, j As Integer
i = 0: j = 0

With Application.Caller
r = .Rows.Count
c = .Columns.Count
End With
ReDim Arr(r - 1, c - 1)

For Each cell In rng
If WorksheetFunction.CountIf(rng.Cells(1, 1).Resize(cell.Row, 1), cell.Value) = 1 Then
Arr(i, j) = cell.Value
If j = c Then j = j + 1
i = i + 1
End If

For k = i To UBound(Arr())
Arr(k, 0) = ""
Next
Next
GetUniqueList = Arr
End Function