Dynamically Create Collection/Array in VBA

Question

I'm struggling with this, I'm doing some stuff in Access with VBA and I need to dynamically create N collections/lists/arrays of records and add them to my dictionary.

//Some pseudo code
Dim dict as object
Set dict = CreateObject("Scripting.Dictionary")

for record in myRecordSetObject
    if dict.exists(keyfromrecord)
         dict(keyfromrecord) = array.add(record)
    else
         newarray = [record]
         dict.add key:="keyfromrecord" item:=array

If it can't be done I might just do a string of primary keys and grow it as needed, then call string split.

---

Edit

So I have my records and I need to divide them into subgroups based on a few common fields that they may or may not share. If two records have the same pieces of information in these select fields they're in a subgroup. A subgroup may have 1 - N records.

Instead of getting all possible combinations and filtering my query I want to create a dictionary that defines it's key as a string generated from these fields. If a key exists then there's a member of that subgroup, if it doesn't it's a new subgroup.

The value was going to be an array of records.

Afterwards I was going to go through my dictionary and do stuff with these records.

Field1     Field2     Field3    Field4
Fruit      Skinned    Sliced    Baked
Apples     True       True      True
Bananas    True       True      True
Oranges    True       False     False

Using this example above subgroup would be when Field2,3 and 4 have the same value. (Apples, Bananas) and the other would be (Oranges)

I want a dictionary with Key being

dictionary{
           "True-True-True": [Apples, Bananas],
           "True-False-True": [Oranges]
}

Answer 1

Not sure if this is what you are after, but this puts a recordset of each combination in at each dictionary key.

Based on your table, it gives keys of

FALSE-FALSE-FALSE-,FALSE-FALSE-TRUE-,FALSE-TRUE-FALSE-,FALSE-TRUE-TRUE-,TRUE-FALSE-FALSE-,TRUE-FALSE-TRUE-,TRUE-TRUE-FALSE-,TRUE-TRUE-TRUE-

where ? dicOutput("TRUE-TRUE-TRUE-").recordcount returns 2 records and GroupTable("0fruits")("TRUE-TRUE-TRUE-").recordcount the same 2

Hope this helps

Function GroupTable(strTableName As String) As Scripting.Dictionary

Dim strKey As String
Dim diccols As New Scripting.Dictionary
Dim dicOutput As Scripting.Dictionary
Dim dicTruth As Scripting.Dictionary
Dim rst As ADODB.Recordset
Dim rcols As ADODB.Recordset

Set rcols = New ADODB.Recordset
Set rcols = CurrentProject.Connection.OpenSchema(adSchemaColumns, Array(Empty, Empty, strTableName, Empty))

While Not rcols.EOF

    If rcols.Fields("COLUMN_NAME").Value <> "Fruit" Then
        diccols.Add CStr(diccols.Count), rcols.Fields("COLUMN_NAME").Value
    End If

    rcols.MoveNext
Wend

Set dicTruth = maketruthtable(2 ^ diccols.Count - 1, diccols.Count)
Set dicOutput = New Scripting.Dictionary

For l = 0 To dicTruth.Count - 1
    strSQL = "select [fruit] from [" & strTableName & "] where " & Join(diccols.Items(), "&") & "='" & dicTruth.Items()(l) & "'"
    Set rst = New ADODB.Recordset
    rst.Open strSQL, CurrentProject.Connection, adOpenStatic
    dicOutput.Add Replace(Replace(dicTruth.Items()(l), "-1", "TRUE-"), "0", "FALSE-"), rst
Next l

Set GroupTable = dicOutput

End Function

Function maketruthtable(intMax As Integer, intOptions As Integer) As Scripting.Dictionary

Dim d As New Scripting.Dictionary
Dim j As Integer

For j = 0 To intMax
    d.Add CStr(j), Replace(Right(DecToBin(j), intOptions), "1", "-1")
Next j

Set maketruthtable = d

End Function

Public Function DecToBin(ByVal lngDec As Long) As String

 Const MAXLEN = 5
 Dim strBin As String
 Dim n As Long

 If lngDec < 0 Then
    strBin = "1"
 Else
    strBin = "0"
 End If

 For n = MAXLEN To 0 Step -1
 If lngDec And (2 ^ n) Then
    strBin = strBin & "1"
 Else
    strBin = strBin & "0"
 End If
 Next

 DecToBin = strBin

 End Function

EDIT

Another solution would be to use SQL to do it, so if you have a table with just TRUE in 1 row and False in another, called tblLogicOptions for example, like so

Then you can use the following SQL on a table called 0Fruits

Using the following SQL

select LOGICTABLE.*,Data.Fruit FROM (select ((x1.a) & (x2.a) & (x3.a)) as Logic from tblLogicOptions  as x1, tblLogicOptions  as x2, tblLogicOptions  as x3) AS LOGICTABLE
LEFT JOIN
(SELECT F1.Fruit, [skinned] & [sliced] & [baked] AS LogicCompare
FROM 0fruits as F1) AS DATA ON LOGICTABLE.Logic=DATA.LogicCompare

Which gives the results

Looping through this to build the dictionary, or even using the resultant recordset perhaps, would be easier I think.

Answer 2

You could use the Redim keyword to change the array size