UniqueItems Function

This function will return the unique items in an array. Used to find the unique items in a column of Excel data.

Borrowed from John Walkenbach and slightly modified

Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant

' Accepts an array or range as input

' If Count = True or is missing, the function returns the number of unique elements

' If Count = False, the function returns a variant array of unique elements

Dim Unique() As Variant ' array that holds the unique items

Dim Element As Variant

Dim i As Integer

Dim FoundMatch As Boolean

' If 2nd argument is missing, assign default value

If IsMissing(Count) Then Count = True

' Counter for number of unique elements

NumUnique = 0

' Loop thru the input array

For Each Element In ArrayIn

FoundMatch = False

' Has item been added yet?

For i = 1 To NumUnique

If Element = Unique(i) Then

FoundMatch = True

GoTo AddItem '(Exit For-Next loop)

End If

Next i

AddItem:

' If not in list, add the item to unique list

If Not FoundMatch Then

NumUnique = NumUnique + 1

ReDim Preserve Unique(NumUnique)

Unique(NumUnique) = Element

End If

Next Element

' Assign a value to the function

If Count Then UniqueItems = NumUnique Else UniqueItems = Unique

End Function