VBA scripting dictionary, multiple items per key and sum/count on items

Question

I am wishing to create a dictionary with multiple items per key. Below is the code I am working with now. I've spend over 7 hours playing with the dictionary and I can't seem to figure it out. I have no problem getting the unique values from a my range input as keys to my dictionary, the problem comes when I want to add items to each key. If the key already exists, I would like to SUM (or add) to that key's item's, or increase the "count" for that key, which would be stored in another item of that key. Perhaps it's best explained through visuals.

Key        Item1      Item2
PersonA    20         SomeOtherVal
PersonB    40         SomeOtherVal
PersonA    80         SomeOtherVal
PersonB    17         SomeOtherVal
PersonC    13         SomeOtherVal

Result:
Key        Item1(Sum) Item2(Count)
PersonA    100        2
PersonB    57         2
PersonC    13         1

So as you can see, all unique items that exist are created as their own key. If the key already exists, Item1 is added to the key's current total, item 2 has a count and that is increased by 1. Below is the code I'm working with, I appreicate your assistance.

Sub dictionaryCreate()

Dim Pair As Variant
Dim q As Range
Dim RAWDATA As Range

Dim d As Dictionary                             'Object
Set d = New Dictionary                          'CreateObject("Scripting.Dictionary")

Set RAWDATA = Worksheets("RAW_DATA").Range(Cells(2, 1), Cells(3000, 1))
For Each q In RAWDATA
    Pair = q.Offset(0, 60).Value + q.Offset(0, 65).Value
    If d.Exists(Pair) Then
        'ADD to item1 SUM
        'Add to item2 COUNT
    Else
        d(Pair) = 1 'create new key
    End If
Next

End Sub

Answer 1

A class object is ideal for this task. For one thing you can create your own data fields, for another you can add further functionality (eg store each individual item or have a function that averages the sum and count) and, most importantly, you can perform arithmetic functions on the fields (such as addition).

The latter is very useful because primitive data types cannot be amended in a Collection type of object. For example you couldn't have in your code d(key) = d(key) + 1 if the item in d is, say, an Integer. You'd have to read the value of d(key) into a temporary variable, increment that by 1, remove the old value and then add the new temporary variable (and if the order in the Collection is important to you then you have an even tougher task). However, objects are stored by reference in these types of Collections, so you can amend the properties of that object to your heart's content.

You'll note that I've been referencing Collection more than Dictionary. This is because I think your requirements are better suited to a Collection: a) I note your raw data could be quite large (perhaps in excess of 3000 items), and I believe that adding to a Collection is quicker, and b) you wouldn't have the hassle of referencing the Runtime library.

Below is an example of a class object with a couple of additional functions to show you how it could work. You create it in your editor with Insert ~> Class Module I've called this class cItems in the Name properties window:

Public Key As String
Public Sum As Long
Public Count As Long
Public ItemList As Collection
Public Function Mean() As Double
    Mean = Sum / Count
End Function
Private Sub Class_Initialize()
    Sum = 0
    Count = 0
    Set ItemList = New Collection
End Sub

You would then add the items to your collection in your main module as follows:

Dim col As Collection
Dim dataItems As cItems
Dim itemKey As String
Dim item1 As Long
Dim ws As Worksheet
Dim r As Long

Set ws = ThisWorkbook.Worksheets("RAW_DATA")
Set col = New Collection

For r = 2 To 3000
    itemKey = CStr(ws.Cells(r, "A").Value2) '~~adjust to your own column(s)
    item1 = CLng(ws.Cells(r, "B").Value2) '~~adjust to your own column(s)

    'Check if key already exists
    Set dataItems = Nothing: On Error Resume Next
    Set dataItems = col(itemKey): On Error GoTo 0

    'If key doesn't exist, create a new class object
    If dataItems Is Nothing Then
        Set dataItems = New cItems
        dataItems.Key = itemKey
        col.Add dataItems, itemKey
    End If

    'Add cell values to the class object
    With dataItems
        .Sum = .Sum + item1
        .Count = .Count + 1
        .ItemList.Add item1
    End With

Next

If you wanted to access any or all of the items you'd do it like so:

'Iterating through all of the items
For Each dataItems In col
    Debug.Print dataItems.Mean
Next

'Selecting one item
Set dataItems = col("PersonA")
Debug.Print dataItems.Mean

Answer 2

*solution is similar @Jeeped's answer, but has some difference.

Sub test()
    Dim i, cl As Range, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    For Each cl In Sheets("RAW_DATA").[A2:A6]
        If Not Dic.Exists(cl.Value) Then
            Dic.Add cl.Value, cl.Offset(, 1).Value2 & "|" & 1
        Else
            Dic(cl.Value) = Split(Dic(cl.Value), "|")(0) + cl.Offset(, 1).Value2 & _
                        "|" & Split(Dic(cl.Value), "|")(1) + 1
        End If
    Next cl
    Debug.Print "Key", "Sum", "Count"
    For Each i In Dic
        Debug.Print i, Split(Dic(i), "|")(0), Split(Dic(i), "|")(1)
    Next i
End Sub

---

test