VBA Scripting.Dictionary object Aggregating data with Scripting.Dictionary (Maximum, Count)

Help us to keep this website almost Ad Free! It takes only 10 seconds of your time:
> Step 1: Go view our video on YouTube: EF Core Bulk Insert
> Step 2: And Like the video. BONUS: You can also share it!

Example

Dictionaries are great for managing information where multiple entries occur, but you are only concerned with a single value for each set of entries — the first or last value, the mininmum or maximum value, an average, a sum etc.

Consider a workbook that holds a log of user activity, with a script that inserts the username and edit date every time someone edits the workbook:

Log worksheet

AB
bob10/12/2016 9:00
alice10/13/2016 13:00
bob10/13/2016 13:30
alice10/13/2016 14:00
alice10/14/2016 13:00

Let's say you want to output the last edit time for each user, into a worksheet named Summary.

Notes:
1. The data is assumed to be in ActiveWorkbook.
2. We are using an array to pull the values from the worksheet; this is more efficient than iterating over each cell.
3. The Dictionary is created using early binding.

Sub LastEdit()
Dim vLog as Variant, vKey as Variant
Dim dict as New Scripting.Dictionary
Dim lastRow As Integer, lastColumn As Integer
Dim i as Long
Dim anchor As Range

With ActiveWorkbook
    With .Sheets("Log")
        'Pull entries in "log" into a variant array
        lastRow = .Range("a" & .Rows.Count).End(xlUp).Row
        vlog = .Range("a1", .Cells(lastRow, 2)).Value2

        'Loop through array
        For i = 1 to lastRow
            Dim username As String
            username = vlog(i, 1)
            Dim editDate As Date
            editDate = vlog(i, 2)

            'If the username is not yet in the dictionary:
            If Not dict.Exists(username) Then
                dict(username) = editDate
            ElseIf dict(username) < editDate Then
                dict(username) = editDate
            End If
        Next
    End With

    With .Sheets("Summary")
        'Loop through keys
        For Each vKey in dict.Keys
            'Add the key and value at the next available row
            Anchor = .Range("A" & .Rows.Count).End(xlUp).Offset(1,0)
            Anchor = vKey
            Anchor.Offset(0,1) = dict(vKey)
        Next vKey
    End With
End With
End Sub

and the output will look like this:

Summary worksheet

AB
bob10/13/2016 13:30
alice10/14/2016 13:00

If on the other hand you want to output how many times each user edited the workbook, the body of the For loop should look like this:

        'Loop through array
        For i = 1 to lastRow
            Dim username As String
            username = vlog(i, 1)

            'If the username is not yet in the dictionary:
            If Not dict.Exists(username) Then
                dict(username) = 1
            Else
                dict(username) = dict(username) + 1
            End If
        Next

and the output will look like this:

Summary worksheet

AB
bob2
alice3


Got any VBA Question?