Unique Cells
A while back, j-walk posted an entry about Filling a ListBox with Unique Items.
Here’s my modified version to transform it into a UDF (User-Defined Function)that can be used in a spreadsheet:
Function Unique(AllCells As Range) As Variant
Dim Cell As Range
Dim ColUnique As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim tmp() As Variant
On Error Resume Next
For Each Cell In AllCells
ColUnique.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0
‘ Sort the collection
For i = 1 To ColUnique.Count - 1
For j = i + 1 To ColUnique.Count
If ColUnique.Item(i) > ColUnique.Item(j) Then
Swap1 = ColUnique.Item(i)
Swap2 = ColUnique.Item(j)
ColUnique.Add Swap1, before:=j
ColUnique.Add Swap2, before:=i
ColUnique.Remove i + 1
ColUnique.Remove j + 1
End If
Next j
Next i
‘ Feed the sorted, non-duplicated items to the temporary array
ReDim Preserve tmp(ColUnique.Count - 1)
For i = 1 To ColUnique.Count
tmp(i - 1) = ColUnique(i)
Next i
Unique = tmp
‘ output the values
If AllCells.Rows.Count >= AllCells.Columns.Count Then
Unique = WorksheetFunction.Transpose(Unique)
End If
Erase tmp
End Function
Here’s how it looks on your sheet:
Remember to press Ctrl+Shift+Enter !
I always get confused when trying to implement UDF’s-so pardon the beginner question. But can you put this code in the Personal.xls file and have it available to all worksheets?
Good luck on the site
Steve
Comment by Steve — January 18, 2005 @ 12:32 am
Hey Steve,
That’s exactly what I’ve done. I have created an add-in (.xla) where I keep all my functions and procedures. I suppose personal.xls is another way of maintaining a common and active directory for your tools. so Yes it should work.
A word of caution (and a reminder for me to correct it) : when you copy from my site and paste the code to VBE, the quotation sign ‘ (for comments) is incorrect.
Fadi
Comment by Fadi — January 18, 2005 @ 8:30 am