Excel VBA: Scripting.Dictionary Calculations

Question

I have the following values in a spreadsheet:

Printer Name | Pages | Copies
HP2300       | 2     | 1
HP2300       | 5     | 1
Laser1       | 2     | 2
Laser1       | 3     | 4
HP2300       | 1     | 1

How can I get the total number of pages printed (pages * copies) on each printer like this:

Printer Name | TotalPages |
HP2300       | 8          |
Laser1       | 16         |

I managed to create a list counting the number of times a printer was used to print:

Sub UniquePrints()

Application.ScreenUpdating = False
Dim Dict As Object
Set Dict = CreateObject("scripting.dictionary")
Dim varray As Variant, element As Variant

varray = Sheets("Prints").Range("E:E").Value
For Each element In varray
    If Dict.exists(element) Then
        Dict.Item(element) = Dict.Item(element) + 1
    Else
        Dict.Add element, 1
    End If
Next

Sheets("Stats").Range("D6").Resize(Dict.Count, 1).Value = _
    WorksheetFunction.Transpose(Dict.keys)
Sheets("Stats").Range("E6").Resize(Dict.Count, 1).Value = _
    WorksheetFunction.Transpose(Dict.items)

Application.ScreenUpdating = True
End Sub

How can I calculate the total pages for each print (row) (pages*copies) and save that in the dictionary instead of just adding 1?

Thank you for your help

no, just in another worksheet using the original worksheet as the datasource. Just seems to be overly complicated to do it as a script. Alternativly use a formula in the next column that calculated the number of pages for each row. — Nathan Fisher, Jun 20 '13 at 06:22
Expand your array to cover the other two columns and loop through using (eg) `for r=1 to ubound(arr,1)` The page counts and number of copies will be in "columns" 2 and 3 of the array: multiply them together and add them to the dictionary instead of just adding one. — Tim Williams, Jun 20 '13 at 06:22

score 1 · Answer 1 · answered Jun 20 '13 at 12:49

It's possible to use an array formula to get cells populated:

={SUMPRODUCT(IF($A$2:$A$6=$F2;1;0);$B$2:$B$6;$C$2:$C$6)}

The formula is inserted from formula window with Ctrl-Shift-Enter. Curled brackets are inserted by excel, not by a user. The formula can be copied elsewhere.

enter image description here

score 1 · Accepted Answer · answered Jun 20 '13 at 13:34

Read in the columns E:G rather than just E and use the second dimension of that array to add pages * copies, rather than adding 1.

Sub UniquePrints()

    Dim Dict As Object
    Dim vaPrinters As Variant
    Dim i As Long

    Set Dict = CreateObject("scripting.dictionary")

    vaPrinters = Sheets("Prints").Range("E2:G6").Value

    For i = LBound(vaPrinters, 1) To UBound(vaPrinters, 1)
        If Dict.exists(vaPrinters(i, 1)) Then
            Dict.Item(vaPrinters(i, 1)) = Dict.Item(vaPrinters(i, 1)) + (vaPrinters(i, 2) * vaPrinters(i, 3))
        Else
            Dict.Add vaPrinters(i, 1), vaPrinters(i, 2) * vaPrinters(i, 3)
        End If
    Next i

    Sheets("Stats").Range("D6").Resize(Dict.Count, 1).Value = _
        WorksheetFunction.Transpose(Dict.keys)
    Sheets("Stats").Range("E6").Resize(Dict.Count, 1).Value = _
        WorksheetFunction.Transpose(Dict.items)

End Sub

Excel VBA: Scripting.Dictionary Calculations

2 Answers2