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]
}

Can you explain a little clearer about what you are trying to do? — Nathan_Sav
– Nathan_Sav, Commented Jun 8, 2017 at 14:09
@Nathan_Sav I added more info, hopefully that makes it clearer — Segfaulter
– Segfaulter, Commented Jun 8, 2017 at 14:30
so you can have table1 with field1 field2 and field3 if both field1 and field2 you want to add fields 1 to 3 to a dictionary with a key of field1_field2 ? — Nathan_Sav
– Nathan_Sav, Commented Jun 8, 2017 at 14:34
Yes. Table1 (actually a query) has records with field1, field2, and field3. Key would be field1_field2_field3, value would be a list of records that have those in common — Segfaulter
– Segfaulter, Commented Jun 8, 2017 at 14:40
so if field 1 row 1 value = field 1 row 2 value add row1 and row2 — Nathan_Sav
– Nathan_Sav, Commented Jun 8, 2017 at 14:48

Nathan_Sav · Accepted Answer · 2017-06-14 10:13:46Z

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.

Steve · Accepted Answer · 2017-06-08 14:25:22Z

0

You could use the Redim keyword to change the array size

answered Jun 8, 2017 at 14:25

Steve

1

1 Comment

Segfaulter Over a year ago

Size isn't the issue. I need to create N arrays and store them in a dictionary.

Collectives™ on Stack Overflow

Dynamically Create Collection/Array in VBA

2 Answers 2

Comments

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related