Identifying Unique Values In An Array Or Range

Category: VBA Functions | [Item URL]

Have you ever had to work with just the unique items in a range? If your data is in the form of a database, you can use the Advanced Filter command to extract the unique items from a single column. But if your data spans multiple columns, Advanced Filter won't work. And the Advanced Filter won't do you any good if your data is in a VBA array.

In this document I present a VBA function that accepts either a worksheet range object or a VBA array. The function returns either:

  • A variant array that consists of just the unique elements in the input array or range (or)
  • A single value: the number of unique elements in the input array or range.

Here's the syntax for the UniqueItems function (which is listed at the end of this document):

 UniqueItems(ArrayIn, Count)

  • ArrayIn: A range object, or an array
  • Count: (Optional) If True or omitted, the function returns a single value - the number of unique items in ArrayIn. If False, the function returns an array that consists of the unique items in ArrayIn.

Example 1

The subroutine below demonstrates UniqueItems. The routine generates 100 random integers and stores them in an array. This array is then passed to the UniqueItems function and a message box displays the number of unique integers in the array. The number will vary each time you run the subroutine.

Sub Test1()
    Dim z(1 To 100)
    For i = 1 To 100
        z(i) = Int(Rnd() * 100)
    Next i
    MsgBox UniqueItems(z, True)
End Sub

Example 2

The subroutine below counts the number of common elements in two worksheet ranges. It creates two arrays. Array1 consists of the unique items in A1:A16; Array2 consists of the unique items in B1:B16. A nested loop counts the number of items that are in both ranges.

Sub Test2()
    Set Range1 = Sheets("Sheet1").Range("A1:A16")
    Set Range2 = Sheets("Sheet1").Range("B1:B16")
    Array1 = UniqueItems(Range1, False)
    Array2 = UniqueItems(Range2, False)
    CommonCount = 0
    For i = LBound(Array1) To UBound(Array1)
        For j = LBound(Array2) To UBound(Array2)
            If Array1(i) = Array2(j) Then _
              CommonCount = CommonCount + 1
        Next j
    Next i
    MsgBox CommonCount
End Sub

Example 3

The UniqueItems function can also be used in worksheet formulas. The formula below returns the number of unique items in a range:


Example 4

To display the unique items in a range, you must array-enter the formula into a range of cells (use Ctrl+Shift+Enter). The result of the UniqueItems function is a horizontal array. If you would like to display the unique values in a column, you can use the TRANSPOSE function. The formula below (which is array-entered into a vertical range) returns the unique items in A1:D21.


The Code

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
                Exit For '(exit loop)
            End If
        Next i
'       If not in list, add the item to unique list
        If Not FoundMatch And Not IsEmpty(Element) 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

(Thanks to Peter Atherton for suggesting the method to avoid converting blanks to zero values)

Search for Tips

All Tips

Browse Tips by Category

Tip Books

Needs tips? Here are two books, with nothing but tips:

Contains more than 200 useful tips and tricks for Excel 2007 | Other Excel 2007 books | Amazon link: John Walkenbach's Favorite Excel 2007 Tips & Tricks

Contains more than 100 useful tips and tricks for Excel 2013 | Other Excel 2013 books | Amazon link: 101 Excel 2013 Tips, Tricks & Timesavers

© Copyright 2019, J-Walk & Associates, Inc.
Privacy Policy