Excel VBA: Practical Guide to Finding Unique Values

Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.

In this blog, we are going to look at how to extract just the unique values from any list. Our focus will be on two techniques, namely Advanced Filter and Dictionary, and at the end, we will check out which technique to use when. Let’s get started.

Dataset & Scenario

Let’s have a look at our dataset. Below we have a list of invoices with open (unpaid) amounts against them.

We will tackle 3 scenarios in this session.

  1. Find unique values from a single column. (i.e. Column C – Store Name)
  2. Find unique values from multiple columns. (i.e. Columns C & H – Store Name and Source)
  3. Find unique values based on certain criteria. (i.e. Column C – Store Name based on Column F – Open Amount, where Open Amount > 10,000)

Advanced Filter

Advanced Filter is an elegant way to filter data quickly and in many different ways, including creating unique lists.

expression.AdvancedFilter (Action, CriteriaRange, CopyToRange, Unique)

Microsoft Docs

There are 3 elements to using Advanced Filters. We have the main dataset called the List Range. We also, have a criteria range where we can specify any conditions that we want to filter the data on. This is optional. And lastly, we have the copy to range which is where we will output the data. This is optional as well, as we can choose to filter the main dataset directly and not necessarily output the data elsewhere.

One thing to remember though is that we always need to provide headers for each of the ranges.

Scenario 1: Unique Value (Single Column)

Below:

  1. rngList is our main dataset which is determined using Current Region.
  2. We want to copy the results to a different worksheet sheet, so choose xlFilterCopy
  3. We won’t be using a Criteria range, so leave it blank.
  4. Provide the copy to range (rngCopyTo), which is the Header – Store Name.
Sub Solution_One_Advanced_Filter_1_Column()

    Dim wsData As Worksheet, wsWork As Worksheet
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsWork = ThisWorkbook.Sheets("Workings")
    
    wsWork.Cells.Clear
    wsWork.Range("A1") = "Store Name"
    
    Dim rngList As Range, rngCopyTo As Range
    Set rngList = wsData.Range("A1").CurrentRegion
    Set rngCopyTo = wsWork.Range("A1:A1")
    
    rngList.AdvancedFilter xlFilterCopy, , rngCopyTo, Unique:=True

End Sub

Scenario 2: Unique Value (Multiple Columns)

Here, we just expand out the Copy To range to include a second header: Source.

Sub Solution_One_Advanced_Filter_2_Column()

    Dim wsData As Worksheet, wsWork As Worksheet
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsWork = ThisWorkbook.Sheets("Workings")
    
    wsWork.Cells.Clear
    wsWork.Range("A1") = "Store Name"
    wsWork.Range("B1") = "Source"
    
    Dim rngList As Range, rngCopyTo As Range
    Set rngList = wsData.Range("A1").CurrentRegion
    Set rngCopyTo = wsWork.Range("A1:B1")
    
    rngList.AdvancedFilter xlFilterCopy, , rngCopyTo, Unique:=True

End Sub

Scenario 3: Unique Value (Based on Criteria)

Now, we need the criteria range, which will be the Header: Open Amount and the actual criteria: >10,000.

Sub Solution_One_Advanced_Filter_Criteria()
    
    Dim wsData As Worksheet, wsWork As Worksheet
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsWork = ThisWorkbook.Sheets("Workings")
    
    wsWork.Cells.Clear
    wsWork.Range("A1") = "Store Name"
    
    wsWork.Range("D1") = "Open Amount"
    wsWork.Range("D2") = ">10000"
    
    Dim rngList As Range, rngCriteria As Range, rngCopyTo As Range
    Set rngList = wsData.Range("A1").CurrentRegion
    Set rngCopyTo = wsWork.Range("A1:A1")
    Set rngCriteria = wsWork.Range("D1:D2")
    
    rngList.AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo, Unique:=True

End Sub

Dictionary

A dictionary is a list of data that holds a key and an item. And the main feature of a dictionary is that the keys will need to be unique.

Scenario 1: Unique Value (Single Column)

Dictionary has a powerful method called Exists which allows us to check whether a particular Key already exists in the dictionary or not. We will use it to check whether the store name already exists in our dictionary, that is, if we have previously added it. If it does exist, we do nothing. But, if it doesn’t exist, we will add it to our dictionary.

Sub Solution_One_Dictionary_Filter_1_Column()

    Dim wsData As Worksheet, wsWork As Worksheet
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsWork = ThisWorkbook.Sheets("Workings")
    
    wsWork.Cells.Clear
    wsWork.Range("A1") = "Store Name"
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim lrow As Long
    lrow = wsData.Range("a1").CurrentRegion.Rows.Count
    
    Dim sStoreName As String
    Dim i As Long
    For i = 2 To lrow
        sStoreName = wsData.Range("C" & i).Value
        If Not dic.exists(sStoreName) Then
            dic.Add Key:=sStoreName, Item:=0
        End If
    Next i
    
    For i = 0 To dic.Count - 1
        wsWork.Range("a" & i + 2).Value = dic.keys()(i)
    Next i

End Sub

Scenario 2: Unique Value (Multiple Columns)

The dictionary object as is, isn’t built for this scenario. We can only feed in one value into the key. So, how can we accommodate two unique values? We need to get a bit creative. We will check out two ways to do this.  One way is to use Classes and a second way is to use the Split function.

Split() Function

Split(expression, [ delimiter, [ limit, [ compare ]]])

Microsoft Docs

Concat Store Name and Source, separating them with a comma. This will be the unique identifier, which we will feed in as the key for dicitionary.

Sub Solution_One_Dictionary_Filter_2_Column_Using_Split()

    Dim wsData As Worksheet, wsWork As Worksheet
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsWork = ThisWorkbook.Sheets("Workings")
    
    wsWork.Cells.Clear
    wsWork.Range("A1") = "Store Name"
    wsWork.Range("B1") = "Source"
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim lrow As Long
    lrow = wsData.Range("a1").CurrentRegion.Rows.Count
    
    Dim sStoreName As String
    Dim sSource As String
    Dim sUnique As String
    Dim sFullString() As String
    
    Dim i As Long
    For i = 2 To lrow
        sStoreName = wsData.Range("C" & i).Value
        sSource = wsData.Range("H" & i).Value
        sUnique = sStoreName & "," & sSource
          
        If Not dic.exists(sUnique) Then
            dic.Add Key:=sUnique, Item:=0
        End If
           
    Next i
    
    For i = 0 To dic.Count - 1
        sFullString() = Split(dic.keys()(i), ",")
        wsWork.Range("a" & i + 2).Value = sFullString(0)
        wsWork.Range("b" & i + 2).Value = sFullString(1)
    Next i

End Sub

Classes

A more elegant way to achieve the same result would by using arrays and classes. For this session, we will look at classes.

Create a class module, by right clicking in the Project window and then, selecting class module.

In the class module, create two variables.

Public StoreName As String
Public Source As String

Within each iteration of the initial For Loop, we will create an object by initializing the class. We will assign the current values of Store Names and Source to the object properties we created above. Then, we will feed in this object as an Item within the dictionary.

And then, at the time of outputing the results, we create an object again based on the Items that are stored within the dictionary. We will extract each property and output it onto the current cells.

Sub Solution_One_Dictionary_Filter_2_Column_Using_Classes()

    Dim wsData As Worksheet, wsWork As Worksheet
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsWork = ThisWorkbook.Sheets("Workings")
    
    wsWork.Cells.Clear
    wsWork.Range("A1") = "Store Name"
    wsWork.Range("B1") = "Source"
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim lrow As Long
    lrow = wsData.Range("a1").CurrentRegion.Rows.Count
    
    Dim sStoreName As String
    Dim sSource As String
    Dim sUnique As String
    Dim objInv As clsInvoice
    Dim i As Long
    
    For i = 2 To lrow
    
    sStoreName = wsData.Range("C" & i).Value
    sSource = wsData.Range("H" & i).Value
    sUnique = sStoreName & "," & sSource
    Set objInv = New clsInvoice
    objInv.StoreName = sStoreName
    objInv.Source = sSource
    
    If Not dic.exists(sUnique) Then
        dic.Add Key:=sUnique, Item:=objInv
    End If
    
    Set objInv = Nothing
    
    Next i
    
    For i = 0 To dic.Count - 1
        Set objInv = dic.items()(i)
        wsWork.Range("A" & i + 2).Value = objInv.StoreName
        wsWork.Range("B" & i + 2).Value = objInv.Source
        Set objInv = Nothing
    Next i

End Sub

Scenario 3: Unique Value (Based on Criteria)

Here, we will simply add the >10000 condition at the time of checking whether the Store Name exists within the dictionary.

Sub Solution_One_Dictionary_Filter_Criteria()

    Dim wsData As Worksheet, wsWork As Worksheet
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsWork = ThisWorkbook.Sheets("Workings")
    
    wsWork.Cells.Clear
    wsWork.Range("A1") = "Store Name"
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim lrow As Long
    lrow = wsData.Range("a1").CurrentRegion.Rows.Count
    
    Dim sStoreName As String
    Dim lOpenAmt As Long
    Dim i As Long
    
    For i = 2 To lrow
    
    sStoreName = wsData.Range("C" & i).Value
    lOpenAmt = wsData.Range("F" & i).Value
    If Not dic.exists(sStoreName) And lOpenAmt > 10000 Then
        dic.Add Key:=sStoreName, Item:=0
    End If
    
    Next i
    
    For i = 0 To dic.Count - 1
        wsWork.Range("A" & i + 2).Value = dic.keys()(i)
    Next i

End Sub

Related Posts