Reputation: 73
Trying to implement a container of containers and can’t seem to figure out the best way to do it. Basically, I have a series of transactions that can contain multiple sub transactions so I’m trying to create a Dictionary of Collections. Each Transaction will have a unique key and hold a series of Sub Transactions. Each Sub Transaction will have a currency (key), notional and commission.
I’ve created a Sub Transaction class with SumNotional and SumCommission items as I’d ideally like to able to track each individual Sub Transaction as well as the net amounts.
Private Sub Class_Initialize()
SumNotional = 0
SumCommission = 0
Set ItemList = New Collection
End Sub
Some pseudo code would theoretically look like:
- Create Dictionary
- Get TransactionKey
- Create Sub Transaction with currency, notional and commission
- If Dictionary(TransactionKey) with currency doesn’t exist
- create new Sub Transaction and add to Dictionary
- Else If Dictionary(TransactionKey) with currency exists
- add line items to Sub Transaction for notional and commission
- and add values to sum variables
Not married to any way of doing it, this just seemed like an effective and efficient way to implement. Example would be data going in looks like:
Transaction Currency Notional Commission
A1 USD 500 50
A2 USD 1,000 100
A2 CAD 750 75
A1 CAD 600 60
A2 EUR 400 40
A1 USD 300 30
A1 CAD 175 20
And results would be a data store looking like
A1 USD 800 80 CAD 775 80 A2 USD 1,000 100 CAD 750 75 EUR 400 40
Upvotes: 0
Views: 705
Reputation: 10715
You could use a dictionary of dictionaries
.
Option Explicit 'add Reference to "Microsoft Scripting Runtime" (VBA Editor -> Tools)
Public Sub NestedList()
Const TR As Long = 1, CU As Long = 2, NO As Long = 3, CO As Long = 4
Dim ws As Worksheet, itms As Dictionary, subs As Dictionary, prop As Dictionary
Dim ur As Variant, lr As Long, r As Long, t As String, c As String
Set ws = Worksheets("Sheet1")
ur = ws.UsedRange
lr = UBound(ur)
Set itms = New Dictionary
For r = 2 To lr
t = ur(r, TR) 'Transaction
c = ur(r, CU) 'Currency
Set prop = New Dictionary
Set subs = New Dictionary
If Not itms.Exists(t) Then
prop.Add Key:="N", Item:=ur(r, NO) 'Notional
prop.Add Key:="C", Item:=ur(r, CO) 'Commission
subs.Add Key:=c, Item:=prop 'Add Currency
itms.Add Key:=t, Item:=subs 'Add Transaction
Else
If Not itms(t).Exists(c) Then
prop.Add Key:="N", Item:=ur(r, NO)
prop.Add Key:="C", Item:=ur(r, CO)
itms(t).Add Key:=c, Item:=prop 'Add Currency
Else
itms(t)(c)("N") = itms(t)(c)("N") + ur(r, NO) 'Sum Notionals
itms(t)(c)("C") = itms(t)(c)("C") + ur(r, CO) 'Sum Commissions
End If
End If
Next
ShowItms itms
End Sub
Private Sub ShowItms(ByRef itms As Dictionary)
Dim t As Variant, c As Variant
For Each t In itms
Debug.Print t
For Each c In itms(t)
Debug.Print vbTab & c & " " & itms(t)(c)("N") & " " & itms(t)(c)("C")
Next
Next
End Sub
At high level:
prop
dictionary, with 2 values N
(Notional) and C
(Commission)prop
dictionary as item to dictionary subs
subs
dictionary to main dictionary (itms
)subs
dictionary doesn't contain current currency
prop
dictionary, with 2 values N
(Notional) and C
(Commission)prop
dictionary to subs(USD)
sub-dictionary, using Currency as keysubs
dictionary to itms(A1)
dictionary (main)At the end we just print the results to the immediate window with the sub ShowItms()
Sheet1
Result:
A1 USD 800 80 CAD 775 80 A2 USD 1000 100 CAD 750 75 EUR 400 40
Upvotes: 2