Dynamically Create Collection/Array in VBA - 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