excelvbascripting.dictionary

Excel VBA: Scripting.Dictionary Calculations


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


Solution

  • 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