Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 ********************* |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
UniqueItems Array
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 u() As Variant Dim Element As Variant Dim i As Integer Dim FoundMatch As Boolean Dim r As Range Set r = Application.Caller ' 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 If NumUnique r.Count Then ReDim Preserve Unique(1 To r.Count) Unique(UBound(Unique)) = (NumUnique - r.Count) + 1 & " more" UniqueItems = Application.Transpose(Unique) ElseIf NumUnique < r.Count Then ReDim Preserve Unique(1 To r.Count) For i = NumUnique + 1 To r.Count Unique(i) = "" Next UniqueItems = Application.Transpose(Unique) Else UniqueItems = Application.Transpose(Unique) End If End If End Function -- Regards, Tom Ogilvy "Darren" wrote: 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 ********************* |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
UniqueItems Array
Hi Tom, Fantastic......... many thanks Darren On Oct 1, 4:21 pm, Tom Ogilvy wrote: 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 u() As Variant Dim Element As Variant Dim i As Integer Dim FoundMatch As Boolean Dim r As Range Set r = Application.Caller ' 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 If NumUnique r.Count Then ReDim Preserve Unique(1 To r.Count) Unique(UBound(Unique)) = (NumUnique - r.Count) + 1 & " more" UniqueItems = Application.Transpose(Unique) ElseIf NumUnique < r.Count Then ReDim Preserve Unique(1 To r.Count) For i = NumUnique + 1 To r.Count Unique(i) = "" Next UniqueItems = Application.Transpose(Unique) Else UniqueItems = Application.Transpose(Unique) End If End If End Function -- Regards, Tom Ogilvy "Darren" wrote: I found the following code on this sitehttp://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 *********************- Hide quoted text - - Show quoted text - |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Complex conditional summing - array COUNT works, array SUM gives#VALUE | Excel Worksheet Functions | |||
Prevent cell/array references from changing when altering/moving thecell/array | Excel Discussion (Misc queries) | |||
meaning of : IF(Switch; Average(array A, array B); array A) | Excel Worksheet Functions | |||
Array problem: Key words-Variant Array, single-element, type mismatch error | Excel Programming | |||
Array problem: Key words-Variant Array, single-element, type mismatch error | Excel Programming |