Use Functions With Dynamic Arrays and Dictionaries

Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.

Each code block covered in the video is given below.

Love using dictionaries and dynamic arrays? But, is it just too much code to set and difficult to read back? Then, try using Functions. We can pass Dictionaries and Dynamic Arrays as Parameters through Functions and Sub-Procedures and even, return them back through Functions. Imagine initializing a whole dictionary in a background and just calling that function from your parent sub. Today, we learn how to transfer an existing, monotonous piece of code with dictionaries and arrays into a compact block of code that just calls the functions and subs where everything is set up.

Initial Code

Sub SingleCode()

Dim sStore As String, lAmount As Long, sSalesPerson As String, i As Long

' Load up a dictionary for the Mapping Data
Dim arrMap() As Variant
arrMap = wsMap.Range("A1").CurrentRegion.Value
Dim dicMap As Object
Set dicMap = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(arrMap, 1)
    sStore = arrMap(i, 1)
    sSalesPerson = arrMap(i, 2)
    If Not dicMap.exists(sStore) Then
        dicMap.Add Key:=sStore, Item:=sSalesPerson
    End If
Next i

'Create a dictionary with unique list of Stores and total outstanding Amount
Dim arrIn() As Variant
arrIn = wsIn.Range("A1").CurrentRegion.Value
Dim dicStore As Object
Set dicStore = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(arrIn, 1)
    sStore = arrIn(i, 3)
    lAmount = arrIn(i, 5)
    If Not dicStore.exists(sStore) Then
        dicStore.Add Key:=sStore, Item:=lAmount
        Else
        dicStore(sStore) = dicStore(sStore) + lAmount
    End If
Next i

' Create a 3-column dynamic array
' 1st Col = Store, 2nd Col = Salesperson via Mapping Lookup, 3rd column = Amount
Dim arrOut() As Variant
ReDim arrOut(1 To dicStore.Count, 1 To 3)
For i = LBound(arrOut, 1) To UBound(arrOut, 1)
    arrOut(i, 1) = dicStore.Keys()(i - 1)
    arrOut(i, 2) = dicMap(dicStore.Keys()(i - 1))
    arrOut(i, 3) = dicStore.Items()(i - 1)
Next i

'Clean the Output sheet
wsOut.Cells.Clear
wsOut.Range("A1").Value = "Store"
wsOut.Range("B1").Value = "SalesPerson"
wsOut.Range("C1").Value = "Amount Outstanding"

'Paste the array
wsOut.Range("A2").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut


End Sub

Transformed Code

Parent Sub

Sub CodeWithFunctions()

' Load up a dictionary for the Mapping Data
Dim dicMap As Object
Set dicMap = FindSalesPerson

'Create a dictionary with unique list of Stores and total outstanding Amount
Dim dicStore As Object
Set dicStore = CreateUniqueListOfStoresWithTotalOutstandingAmounts

' Create a 3-column dynamic array
' 1st Col = Store, 2nd Col = Salesperson via Mapping Lookup, 3rd column = Amount
Dim arrOut() As Variant
arrOut = CreateOutputArray(dicStore, dicMap)

'Clean the Output sheet
PrepareOutputSheet

'Paste the array
PasteOutputArray (arrOut)

End Sub

Supporting Code

Function FindSalesPerson() As Object

Dim sStore As String, sSalesPerson As String, i As Long

' Load up a dictionary for the Mapping Data
Dim arrMap() As Variant
arrMap = wsMap.Range("A1").CurrentRegion.Value
Dim dicMap As Object
Set dicMap = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(arrMap, 1)
    sStore = arrMap(i, 1)
    sSalesPerson = arrMap(i, 2)
    If Not dicMap.exists(sStore) Then
        dicMap.Add Key:=sStore, Item:=sSalesPerson
    End If
Next i

Set FindSalesPerson = dicMap
End Function

Sub test()
Dim dic As Object
Set dic = FindSalesPerson
MsgBox dic("Hi-Fi Albany")
End Sub

Function CreateUniqueListOfStoresWithTotalOutstandingAmounts() As Object
Dim sStore As String, lAmount As Long, i As Long
'Create a unique list of Stores with total outstanding
Dim arrIn() As Variant
arrIn = wsIn.Range("A1").CurrentRegion.Value
Dim dicStore As Object
Set dicStore = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(arrIn, 1)
    sStore = arrIn(i, 3)
    lAmount = arrIn(i, 5)
    If Not dicStore.exists(sStore) Then
        dicStore.Add Key:=sStore, Item:=lAmount
        Else
        dicStore(sStore) = dicStore(sStore) + lAmount
    End If
Next i

Set CreateUniqueListOfStoresWithTotalOutstandingAmounts = dicStore
End Function


Function CreateOutputArray(ByRef dicStore As Object, ByRef dicMap As Object) As Variant
Dim i As Long
Dim arrOut() As Variant
ReDim arrOut(1 To dicStore.Count, 1 To 3)
For i = LBound(arrOut, 1) To UBound(arrOut, 1)
    arrOut(i, 1) = dicStore.Keys()(i - 1)
    arrOut(i, 2) = dicMap(dicStore.Keys()(i - 1))
    arrOut(i, 3) = dicStore.Items()(i - 1)
Next i

CreateOutputArray = arrOut
End Function

Sub PrepareOutputSheet()
wsOut.Cells.Clear
wsOut.Range("A1").Value = "Store"
wsOut.Range("B1").Value = "SalesPerson"
wsOut.Range("C1").Value = "Amount Outstanding"
End Sub

Sub PasteOutputArray(ByRef arrOut As Variant)
wsOut.Range("A2").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
End Sub

Related Posts