Want to become an expert in VBA? So this is the right place for you. This blog mainly focus on teaching how to apply Visual Basic for Microsoft Excel. So improve the functionality of your excel workbooks with the aid of this blog. Also ask any questions you have regarding MS Excel and applying VBA. We are happy to assist you.

VBA - Get Unique Values From Column Into Array

When developing Excel VBA programs, sometimes we need to get unique values from a column into an array. Particularly when creating dynamic lists for dropdowns or generating reports. For an example assume you have a dropdown in your VBA program. Suppose that it needs to be updated with the data entered by the user. If the related data is stored in a column, then we can use that column to populate the dropdown. But what, if values are repeated in the column? We don’t show duplicate values in a dropdown list. So then you need to get only unique values to the dropdown. To do that first we can add unique values from column to an array. Then we can easily create the list of the dropdown using that array. So in this lesson you will learn how to populate an array from unique values of a given column. Also I’m going to develop a VBA function for this. So you can readily use it in your VBA programs.

Below is the list I’m going to use for this lesson. It is a list of asset ids. And they are listed in column A.

List of asset ids

This is not a list of unique values. Because some asset ids are repeated in the column. So now let’s see how we can add only unique values from this column to a VBA array. I’m going to create a custom VBA function for this.

Function GetUniqueValuesFromColumnIntoArray(WS As Worksheet, ColumnName As String) As String()

End Function

This VBA function has two parameters. WS and ColumnName. I added these two parameters to input the worksheet name and the column. So you can reuse this for your worksheets easily. Also note that the return type of the VBA function is String(). This is because the function needs to return an array. Want to learn more about returning an array from a VBA function? Check this post.

How to Return an Array From VBA Function

Now we have declared the function name with parameters. Next we need to declare a few variables.

Dim WS_ColumnName_LastRow As Long
Dim i As Long
Dim j As Long
Dim Counter As Long
Dim AllValues() As String
Dim UniqueValues() As String
Dim ValueFound As Boolean

AllValues() array will hold all the values from the column. The UniqueValues() variable will hold only the unique values from the column.

Next, find the last row of the list.

With WS
     WS_ColumnName_LastRow = .Cells(.Rows.Count, ColumnName).End(xlUp).Row
End With

Size the “AllValues” dynamic array that has already been formally declared.

ReDim AllValues(1 To WS_ColumnName_LastRow)

Populate the AllValues array using a For Next statement.

For i = 1 To WS_ColumnName_LastRow
     AllValues(i) = WS.Range(ColumnName & i).Value
Next i

Then we need to size the UniqueValues array. Here we size the UniqueValues array to the same size of the AllValues array. Because at this moment we don’t know how many unique values we will have in the array. Once all the unique values are populated then we can resize the array to appropriate size.

ReDim UniqueValues(1 To WS_ColumnName_LastRow)

Add the first element from AllValues to the UniqueValues array.

UniqueValues(1) = AllValues(1)

Next we use a nested For Next statement to find unique values.

Counter = 1
For i = 1 To WS_ColumnName_LastRow
     ValueFound = False
     For j = 1 To Counter
          If StrComp(AllValues(i), UniqueValues(j), vbTextCompare) = 0 Then
              ValueFound = True
              Exit For
          End If
     Next j
     If ValueFound = False Then
          Counter = Counter + 1
          UniqueValues(Counter) = AllValues(i)
     End If
Next i

In the above code, the outer For Next statement is used to iterate through the elements of the AllValues array.

For i = 1 To WS_ColumnName_LastRow

Next i

Then this inner For Next statement is used to iterate through existing(Newly adding) elements of the UniqueValues array.

For j = 1 To Counter

Next j

StrComp function returns 0 if the elements of the two arrays are matching.

StrComp(AllValues(i), UniqueValues(j), vbTextCompare)

Here the variable ValueFound is used as a flag.

If the value is not found among the elements of the UniqueValues array, then this new value is added as the next element.

If ValueFound = False Then
     Counter = Counter + 1
     UniqueValues(Counter) = AllValues(i)
End If

Once all the unique values are collected to the UniqueValues array, we can resize the UniqueValues array as follows. Use the Preserve keyword to keep the existing values while resizing the array. If not, all the values will be erased.

ReDim Preserve UniqueValues(1 To Counter)

Finally, the function returns the UniqueValues array as the output.

GetUniqueValuesFromColumnIntoArray = UniqueValues

And Below is the full code of the function.

Function GetUniqueValuesFromColumnIntoArray(WS As Worksheet, ColumnName As String) As String()

     Dim WS_ColumnName_LastRow As Long
     Dim i As Long
     Dim j As Long
     Dim Counter As Long
     Dim AllValues() As String
     Dim UniqueValues() As String
     Dim ValueFound As Boolean

     With WS
          WS_ColumnName_LastRow = .Cells(.Rows.Count, ColumnName).End(xlUp).Row
     End With

     ReDim AllValues(1 To WS_ColumnName_LastRow)

     For i = 1 To WS_ColumnName_LastRow
          AllValues(i) = WS.Range(ColumnName & i).Value
     Next i

     ReDim UniqueValues(1 To WS_ColumnName_LastRow)
     UniqueValues(1) = AllValues(1)
     Counter = 1
     For i = 1 To WS_ColumnName_LastRow
          ValueFound = False
          For j = 1 To Counter
               If StrComp(AllValues(i), UniqueValues(j), vbTextCompare) = 0 Then
                    ValueFound = True
                    Exit For
               End If
          Next j
          If ValueFound = False Then
               Counter = Counter + 1
               UniqueValues(Counter) = AllValues(i)
          End If
     Next i

     ReDim Preserve UniqueValues(1 To Counter)
     GetUniqueValuesFromColumnIntoArray = UniqueValues

End Function

You can use this function inside a subroutine like this. Assume the name of the worksheet is “Data”.

Sub Test()

     Dim WS As Worksheet
     Dim UniqueIds() As String

     Set WS = Worksheets("Data")

     UniqueIds = GetUniqueValuesFromColumnIntoArray(WS, "A")

End Sub

Add a breakpoint at “End Sub” and run the program. Then view the UniqueIds array in the “Locals” window.

View the array with unique values

The example worksheet we considered above has a header in row 1. Therefore we have the header “Asset ID” also in the result array. But sometimes you might need to populate unique values into an array without the header. There are few different ways to achieve this. Also you can do it by changing the function or changing the subroutine. In here I will show you how to modify the subroutine to get unique values without the header.

Here is how we can modify the subroutine. Once we get the unique values to the array, we can iterate through all the elements using a For Next statement. While loop through the elements we can decrement the index of each and every element by 1. Then the first element which is the header will be removed. Finally we can resize the array to one less than the original size. To keep the current values use the Preserve keyword when resizing.

Sub Test_2()

     Dim WS As Worksheet
     Dim UniqueIds() As String
     Dim i As Long

     Set WS = Worksheets("Data")

     UniqueIds = GetUniqueValuesFromColumnIntoArray(WS, "A")

     For i = 1 To UBound(UniqueIds) - 1
          UniqueIds(i) = UniqueIds(i + 1)
     Next i

     ReDim Preserve UniqueIds(1 To UBound(UniqueIds) - 1)

End Sub

Below is the outcome of the above subroutine.

Adding unique values from a column into an array

Also Read
Fill a Listbox From an Array
Transposing an Array in VBA
Re-size Dynamic Arrays
Quickly Write Multidimensional Array to Excel Range

Contact Form

Name

Email *

Message *