View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Darren[_11_] Darren[_11_] is offline
external usenet poster
 
Posts: 3
Default UniqueItems Array

I found the following code on this site http://www.j-walk.com/ss/excel/index.htm,
and it returns a list of unique items in a given range by entering an
array in the worksheet eg
{=uniqueitems(A1:A100,FALSE)}

Problem is that I do not know how many unique items are going to be
returned from the list so if I enter the array formula in B1:B50 and
there are 25 unique items then the formula returns #N/A in the other
25 cells.

Is there any way to change either the VBA code below or the array
formula so that #N/A is not returned.

Many thanks for any help provided

D

CODE STARTS *******************

Option Base 1
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 = Application.Transpose(Unique)

End Function

CODE ENDS *********************