# Unique Item Function

#### dennisli

##### Well-known Member
In Excel, you can use Advanced Autofilter to get unique value, is it possible to get unique item using one custom function or combined built in functions given a range?
For example, given a range A10:A100, from cell B10 and down, you can get the unique item? Like UniqueItem(A\$10:A\$100). B10 if for first unique data, B11 is for second unique data.
Thanks lot.
Dennis

### Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

#### iliace

##### Well-known Member

Code:
``````Public Function UniqueValues(theRange As Range) As Variant
Dim colUniques As New VBA.Collection
Dim vArr As Variant
Dim vCell As Variant
Dim vLcell As Variant
Dim oRng As Excel.Range
Dim i As Long
Dim vUnique As Variant
Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
vArr = oRng
On Error Resume Next
For Each vCell In vArr
If vCell <> vLcell Then
If Len(CStr(vCell)) > 0 Then
End If
End If
vLcell = vCell
Next vCell
On Error GoTo 0

ReDim vUnique(1 To colUniques.Count)
For i = LBound(vUnique) To UBound(vUnique)
vUnique(i) = colUniques(i)
Next i

UniqueValues = vUnique
End Function``````

Use as an array formula. So for instance, when my list of values is B5:B69, I select D14:Q14, then type =UniqueValues(B5:B69) and press Ctrl+Shift+Enter. If you select more cells than there are unique values you'll get #N/A for the extras.

Last edited:

#### DonkeyOte

##### MrExcel MVP
Slightly different approach -- would return unique x value, ie

=UNIQUE(\$A\$10:\$A\$100,1) would return first unique value in the in the range.

could adjust 1 obviously ie UNIQUE(A10:A100,ROW(B10)-9) which you could copy down (would return 0 where no unique value exists), however, if you want the range returned in one go then iliace's solution is certainly the one for you... if want to return say the xth unique value into a given cell then this would work.

Code:
``````Function Unique(f_rng, rnk As Long)
Dim cell As Range
Dim f_str As String
Dim f_i As Integer
Dim ans As Variant
For Each cell In f_rng
Select Case InStr(f_str, cell.Value)
Case 0
cnt = WorksheetFunction.CountIf(f_rng, cell.Value)
If cnt = 1 Then
f_i = f_i + 1
If f_i = rnk Then
ans = cell.Value
Exit For
End If
End If
End Select
Next cell
Unique = ans
End Function``````

#### dennisli

##### Well-known Member
thats' wonderful. thanks.

#### DonkeyOte

##### MrExcel MVP
I missed one line in mine... so just in case you decided to use it...

Code:
``````Function Unique(f_rng, rnk As Long)
Dim cell As Range
Dim f_str As String
Dim f_i As Integer
Dim ans As Variant
For Each cell In f_rng
Select Case InStr(f_str, cell.Value)
Case 0
cnt = WorksheetFunction.CountIf(f_rng, cell.Value)
If cnt = 1 Then
f_i = f_i + 1
<b>f_str = f_str & "," & cell.Value</b>
If f_i = rnk Then
ans = cell.Value
Exit For
End If
End If
End Select
Next cell
Unique = ans
End Function``````

To reiterate though iliace's is the more elegant (by far).

#### Fazza

##### MrExcel MVP
This may be of interest. For example put it into your personal macro workbook and assign short cut key CTRL-SHIFT-U (for Unique).

Just a quick way to use the built in advanced filter of unique items to put the unique items in the first row one column clear of the last entry in the column. To use: select the data to be filtered, including header, and then execute the code. I use it all the time in my work. BTW, not everyone knows this can be used on more than one field but this is also standard functionality.

HTH, Fazza

Code:
``````Sub UniqueItems()
On Error GoTo ErrorHandler
With Selection
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 2), Unique:=True
End With
ResumeHere:
Exit Sub

ErrorHandler:
MsgBox prompt:="Something went wrong !!", Buttons:=vbCritical, Title:="Error ..."
GoTo ResumeHere
End Sub``````

#### jindon

##### MrExcel MVP
Select B1:B100
Enter =dennis(A1:A100)
Confirm with Ctrl + Shift + Enter
Code:
``````Function dennis(rng As Range) As Variant
Dim a, e
a = rng.Value
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each e In a
If (Not IsEmpty(e)) * (Not .exists(e)) Then .add e, Nothing
Next
dennis = Application.Transpose(.keys)
End With
End Function``````

##### MrExcel MVP
for a formula approach:

=INDEX(\$A\$10:\$A\$100,SMALL(IF(FREQUENCY(IF(\$A\$10:\$A\$100<>"",MATCH("~"&\$A\$10:\$A\$100,\$A\$10:\$A\$100&"",0)),ROW(\$A\$10:\$A\$100)-ROW(\$A\$10)+1),ROW(\$A\$10:\$A\$100)-ROW(\$A\$10)+1),ROWS(\$A\$10:A10)))

...entered with control + shift + enter, not just enter. also, don't forget the:

filter | advanced filter - copy to another location & unique records only

...option.

Replies
0
Views
309
Replies
17
Views
706
Replies
2
Views
525
Replies
13
Views
429
Replies
2
Views
611

1,191,025
Messages
5,984,195
Members
439,877
Latest member
kellylet

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back