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