Something like a Public constant populated dictionary - vba

Question

In VBA what's the best way to declare a Public constant collection/dictionary of elements with multiple properties like this?
Dim fruits as new dictionary
fruits.add "banana", array("yellow", "long", "curved")
fruits.add "watermelon", array("red", "big", "sferic")
fruits.add "blueberry", array("blue", "little", "sferic")
I could change the Dim fruits as new dictionaryintoPublic fruits as new dictionary moved on top (outside procedure) but how could I populate this dictionary once for multiple sub/functions that will use it?
I could put all the three "add" instructions in a dedicated sub called "fruits_populate()", and call this sub at the beginning in each sub/function where I use it but is there a better solution?

Answer 1

One solution would be to simulate a memoised getter:
Public Function FRUITS() As Dictionary
Static obj As Dictionary ' Static keeps the object between calls '
If obj Is Nothing Then
Set obj = New Dictionary
obj.add "banana", Array("yellow", "long", "curved")
obj.add "watermelon", Array("red", "big", "sferic")
obj.add "blueberry", Array("blue", "little", "sferic")
End If
Set FRUITS = obj
End Sub
Then to get an item:
Debug.Print FRUITS.Item("banana")(1)
Another way would be to implement a class module ClsFruits.cls :
Dim base As Dictionary
Private Sub Class_Initialize()
Set base = New Dictionary
base.add "banana", Array("yellow", "long", "curved")
base.add "watermelon", Array("red", "big", "sferic")
base.add "blueberry", Array("blue", "little", "sferic")
End Sub
Public Property Get Item(Key)
Item = base.Item(Key)
End Property
Then to get an item:
Dim fruits As New ClsFruits
Sub Test()
Debug.Print fruits.Item("banana")(1)
End Sub

Answer 2

Originally a comment, but it grew too long:
1) It is easy to declare a public dictionary (as you already know), but
2) It is not possible to initialize it with a literal -- you need to run some set-up code that runs before any other code. Workbook_Open() is a natural place for such code.
3) There is no way to lock it down as constant -- dictionaries are mutable, but
4) If you really want, you could define your own class of objects that refuse to update themselves.
To expand on point 2). It is probably still a good idea to write a dedicated sub such as fruits_populate(). Put that code in a public module, and then in the Workbook code module put:
Private Sub Workbook_Open()
fruits_populate
End Sub
The advantage of doing it this way is that if you get to the point of doing robust error-handling, you might want to be able to bounce back from loss of state (e.g. a runtime error causes the project to reset), in which case you might have reason to call fruits_populate() from some error-handling code.

Answer 3

You can create your own Fruits object (dictionary).
You can set the VB_PredeclaredId set to True to act as a global default instance (access it from anywhere in your program) and the Item as the default member so you don't have to call it each time.
To do this:
Create a Class Module
Export
Replace with below code
Import
Fruits Class:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Fruits"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_fruits As Object
Public Property Get Item(ByVal Name As String) As Variant
Attribute Item.VB_UserMemId = 0
Item = m_fruits(Name)
End Property
Public Property Let Item(ByVal Name As String, ByVal Value As Variant)
m_fruits(Name) = Value
End Property
Public Sub Clear()
m_fruits.RemoveAll
End Sub
'For testing - can omit
Public Function Names() As Variant
Names = m_fruits.Keys
End Function
Private Sub Class_Initialize()
Set m_fruits = CreateObject("Scripting.Dictionary")
End Sub
A simple test:
Sub Test()
Fruits("Banana") = Array("yellow", "long", "curved")
Fruits("Watermelon") = Array("red", "big", "sferic")
Fruits("Blueberry") = Array("blue", "little", "sferic")
PrintFruits
Fruits.Clear
End Sub
Private Sub PrintFruits()
Dim d As Variant, idx As Integer
For Each d In Fruits.Names()
Debug.Print "Fruit: " & d
For idx = 0 To UBound(Fruits(d))
Debug.Print String(3, " ") & Fruits(d)(idx)
Next idx
Next d
End Sub
'Output:
'Fruit: Banana
'yellow
'long
'curved
'Fruit: Watermelon
'red
'big
'sferic
'Fruit: Blueberry
'blue
'little
'sferic