Unique Values From Data Using VBA Dictionary Object

Posted: April 19, 2013 by MaxFraudy in Excel, VBA
Tags: , ,

Very often when we are working with huge amount of data, many a times we need to get unique values from a list. e.g. from region-wise sales data, a unique list of product names. Also, when using form controls like a dropdown (combobox) or a list box, we want to get unique values from a range that will be used as input for that control. While there are many ways to get this done, perhaps the most efficient one is using dictionary objects.

The program written below does exactly as required (Thanks to Transformer for his code). It is a parameterised function that takes the following arguments:

   varSource = source data from which unique values are to be extracted
   blnPaste = TRUE if you want the result to be pasted to a range, FALSE by default
   rngDest = range where the results are to be pasted
   blnCase = TRUE if the list is to case-sensitive, FALSE by default. The results will be in proper case for FALSE
   blnCounts = TRUE if you want to see the number of occurrences of each item as well, FALSE by default

Function varUniqueList(varSource As Variant, _
                   Optional blnPaste As Boolean = False, _
                   Optional rngDest As Range, _
                   Optional blnCase As Boolean = True, _
                   Optional blnCounts As Boolean = False)

Dim lngLoop         As Long
Dim strKey          As String
Dim objDictionary   As Object

If IsArray(varSource) Then  'proceeding only if the array is non-empty
    Set objDictionary = CreateObject("Scripting.Dictionary")

    With objDictionary
        For lngLoop = LBound(varSource) To UBound(varSource)

            If blnCase Then
                strKey = varSource(lngLoop)
                strKey = StrConv(varSource(lngLoop), vbProperCase)
            End If
        .Item(strKey) = .Item(strKey) + 1 'counting occurences
        Next lngLoop

        If blnCounts Then
            varUniqueList = Array(.keys, .items)
            varUniqueList = Array(.keys)
        End If

        'pasting results in destination range
        If blnPaste And Not rngDest Is Nothing Then 
            rngDest.Resize(.Count, 1-blnCounts).Value = Application.Transpose(varUniqueList)
        End If
    End With

    Set objDictionary = Nothing
    Exit Function
End If

End Function

This function can be called from any other procedure like below. Here rngSource is the range which contains the data and rngDest is the range where results are to be pasted.

Sub Start() 
Dim varData      As Variant 
Dim varResult    As Variant 
Dim rngRes       As Range 

    With ThisWorkbook.Worksheets("Sheet1") 
        vardata = Application.Transpose(.Range("rngSource")) 
        Set rngRes = .Range("rngDest") 
        Call varUniqueList(varData, True, rngRes) 'for pasting data
        varResult = varUniqueList(varData)        'result array
    End With 
End Sub
  1. MaxFraudy says:

    A newer and better version of this code is available on the blog now. Please see this:

Share your thoughts/feedback

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s