Loading a VBA Dictionary which Sums Duplicate Keys - vba

Question

I am trying to use a dictionary to perform a lookup. I am getting some incorrect results because of duplicates in the data I am lookup up to. Below is the "formula version" of my lookup:
=IFERROR(VLOOKUP([#[Contract]],'Subs Summary'!I:P,8,FALSE),0)
The issue is that on the Subs Summary worksheet, the "Contract" (Column I) can have multiple lines with the same contract (and the Vloookup only pulls back the first line it finds the contract on). I want to perform the lookup via a dictionary and when a duplicate contract occurs, to SUM the values in column P (instead of only retrieving the first instance / line).
Below is my current Code for the dictionary loading and lookup:
Dim x, x2, y, y2()
Dim i As Long
Dim dict As Object
Dim LastRowTwo As Long, shtOrders As Worksheet, shtReport As Worksheet
Set shtOrders = Worksheets("Orders")
Set shtReport = Worksheets("Subs Summary")
Set dict = CreateObject("Scripting.Dictionary")
'get the lookup dictionary from Report
With shtReport
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
x = .Range("I2:I" & lastRow).Value
x2 = .Range("P2:P" & lastRow).Value
For i = 1 To UBound(x, 1)
dict.Item(x(i, 1)) = x2(i, 1)
Next i
End With
'map the values
With shtOrders
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
y = .Range("C2:C" & lastRow).Value 'looks up to this range
ReDim y2(1 To UBound(y, 1), 1 To 1) '<< size the output array
For i = 1 To UBound(y, 1)
If dict.exists(y(i, 1)) Then
y2(i, 1) = dict(y(i, 1))
Else
y2(i, 1) = "0"
End If
Next i
.Range("CM2:CM" & lastRow).Value = y2 '<< place the output on the sheet
End With
This code (I believe) is be performing the Vlookup correctly, but without handling the duplicates at all. I am trying to code a check if the key (in Column I) exists already in the dictionary, and if so, sum the line's value in Column P to already existing column P values for that contract/key. There are often times where a key/ contract will have 4 lines in the lookup page (Subs Summary).
Any input is greatly appreciated - I am fairly new to dictionaries and VBA in general, so it could be that my existing code has another issue / inefficiency. It does run without error and retrieves correct values except for duplicates as far as I can tell.
Cheers!

Answer 1

I was able to adapt my above posted code by adjusting / adding this portion:
If Not dict.exists(x(i, 1)) Then
dict.Add x(i, 1), x2(i, 1)
Else
dict.Item(x(i, 1)) = CDbl(dict.Item(x(i, 1))) + CDbl(x2(i, 1))
End If
Next i
SUMIFS did not end up working because there was duplicates on both the "Orders" worksheet as well as the "Subs Summary" worksheet. Perhaps there is a way to do this using only SUMIFS, but the code (shown below) in it's entirety, works great.
Dim x, x2, y, y2()
Dim i As Long
Dim dict As Object
Dim LastRowTwo As Long, shtOrders As Worksheet, shtReport As Worksheet
Set shtOrders = Worksheets("Orders")
Set shtReport = Worksheets("Subs Summary")
Set dict = CreateObject("Scripting.Dictionary")
'get the lookup dictionary from Report
With shtReport
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
x = .Range("I2:I" & lastRow).Value
x2 = .Range("P2:P" & lastRow).Value
For i = 1 To UBound(x, 1)
If Not dict.exists(x(i, 1)) Then
dict.Add x(i, 1), x2(i, 1)
Else
dict.Item(x(i, 1)) = CDbl(dict.Item(x(i, 1))) + CDbl(x2(i, 1))
End If
Next i
End With
'map the values
With shtOrders
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
y = .Range("C2:C" & lastRow).Value 'looks up to this range
ReDim y2(1 To UBound(y, 1), 1 To 1) '<< size the output array
For i = 1 To UBound(y, 1)
If dict.exists(y(i, 1)) Then
y2(i, 1) = dict(y(i, 1))
Else
y2(i, 1) = "0"
End If
Thanks all!
Next i
.Range("CM2:CM" & lastRow).Value = y2 '<< place the output on the sheet
End With