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.
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.
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 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.
WS_ColumnName_LastRow = .Cells(.Rows.Count, ColumnName).End(xlUp).Row
End With
Size the “AllValues” dynamic array that has already been formally declared.
Populate the AllValues array using a For Next statement.
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.
Add the first element from AllValues to the UniqueValues array.
Next we use a nested For Next statement to find unique values.
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.
Next i
Then this inner For Next statement is used to iterate through existing(Newly adding) elements of the UniqueValues array.
Next j
StrComp function returns 0 if the elements of the two arrays are matching.
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.
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.
Finally, the function returns the UniqueValues array as the output.
And Below is the full code of the function.
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”.
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.
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.
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.
Also Read
Fill a Listbox From an Array
Transposing an Array in VBA
Re-size Dynamic Arrays
Quickly Write Multidimensional Array to Excel Range
