Extract Unique Values List

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

Code:

---

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

---

Hi Rajan,

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

Rajiv

Quote:

---

Originally Posted by Rajan_Verma

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

Code:

---

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

---

---

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

Code:

---


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

---

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)

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