Pdfins
Pdfins

Reputation: 73

Excel VBA - Dictionary of collections (with some other methods and items)

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

Answers (1)

paul bica
paul bica

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:

  • Get intended sheet to work with (Sheet1)
  • Get its UsedRange into a variant array (ur)
  • Get last row: lr = Ubound(ur, 1) - upper bound of dimension 1 (implied in the code)
  • Initialize main dictionary (outside of the loop)
  • Loop over all rows in the array / sheet
    • If main dictionary doesn't contain current transaction (ex. A1)
      • Add a new prop dictionary, with 2 values N (Notional) and C (Commission)
      • Add prop dictionary as item to dictionary subs
      • Add subs dictionary to main dictionary (itms)
  • Else (main dictionary contains current transaction A1)
    • If subs dictionary doesn't contain current currency
      • Add a new prop dictionary, with 2 values N (Notional) and C (Commission)
      • Add prop dictionary to subs(USD) sub-dictionary, using Currency as key
      • Add subs dictionary to itms(A1) dictionary (main)
    • Else
      • Sum up the Notionals values accumulated so far (for this Transaction and Currency)
      • Sum up the Commissions values accumulated so far

At the end we just print the results to the immediate window with the sub ShowItms()


Sheet1

Sheet1

Result:

A1
    USD 800 80
    CAD 775 80
A2
    USD 1000 100
    CAD 750 75
    EUR 400 40

Upvotes: 2

Related Questions