VBA Scripting.Dictionary object Aggregating data with Scripting.Dictionary (Maximum, Count)
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:
Logworksheet
A B bob 10/12/2016 9:00 alice 10/13/2016 13:00 bob 10/13/2016 13:30 alice 10/13/2016 14:00 alice 10/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:
Summaryworksheet
A B bob 10/13/2016 13:30 alice 10/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:
Summaryworksheet
A B bob 2 alice 3
