20150304 Revising a complex test data generator worksheet with VBA scripts
I have hidden ranges that specify interaction options for matched rows in the data entry area. I need to increase speed when referencing this range for each row so looking at options for reading and accessing it in memory. Previous script was for each cell in the data entry area individually finding the reference cell in the table .
Was interested in trying to implement something in excel similar to the Javascript JSON object.. I could just use an array but this is more interesting and allows me to use meanignful keys to identify the elements.
Heres initial implementations of Excel classes using collections of collections just for fun.
2 Levels
Option Explicit ' CollectionsX2 ' Collection of collections ' Remember: if you use a number as a key, it must be stringified beforehand else it will be treated an an index Private ThisCollection As New Collection Private Function CollectionContains(col As Collection, key As Variant) As Boolean ' As the returned element can be either a object or a descrete variable here is a working solution: ' thanks to http://stackoverflow.com/questions/40651/check-if-a-record-exists-in-a-vb6-collection On Error Resume Next col.Item key CollectionContains = (err.Number = 0) err.Clear End Function Sub SetValue(key1, key2, value) key1 = UCase(key1) key2 = UCase(key2) Dim collection2 As Collection ' Does element key1 exist in our top level collection? If Not CollectionContains(ThisCollection, key1) Then ' key1 does not exist Set collection2 = New Collection Call ThisCollection.ADD(collection2, key1) End If Set collection2 = ThisCollection.Item(key1) ' Does element key2 exist in our second level collection? If CollectionContains(collection2, key2) Then collection2.REMOVE key2 End If ' Add key2/Value Call collection2.ADD(value, key2) End Sub Function GetValue(key1, key2, valueToReturnIfNotFound) key1 = UCase(key1) key2 = UCase(key2) Dim collection2 As Collection GetValue = valueToReturnIfNotFound ' Does element key1 exist in our top level collection? If CollectionContains(ThisCollection, key1) Then Set collection2 = ThisCollection(key1) ' Does element key2 exist in our second level collection? If CollectionContains(collection2, key2) Then GetValue = collection2(key2) End If End If End Function Function ElementExistsForKey1Key2(key1 As String, key2 As String) As Boolean key1 = UCase(key1) key2 = UCase(key2) ElementExistsForKey1Key2 = False Dim collection2 As Collection ' Does element keyPri exist in our top level collection? If CollectionContains(ThisCollection, key1) Then Set collection2 = ThisCollection(key1) If CollectionContains(collection2, key2) Then ElementExistsForKey1Key2 = True End If End If End Function
And I also had a need for a collection of collections of collections.. whoa stop now
Option Explicit ' CollectionsX3 ' Collection of collections of collections ' Remember: if you use a number as a key, it must be stringified beforehand else it will be treated an an index Private ThisCollection As New Collection Function CollectionContains(col As Collection, key As Variant) As Boolean ' As the returned element can be either a object or a descrete variable here is a working solution: ' thanks to http://stackoverflow.com/questions/40651/check-if-a-record-exists-in-a-vb6-collection On Error Resume Next col.Item key CollectionContains = (err.Number = 0) err.Clear End Function Sub SetValue(key1 As String, key2 As String, key3 As String, value) key1 = UCase(key1) key2 = UCase(key2) key3 = UCase(key3) Dim collection2 As Collection Dim collection3 As Collection ' Does element key1 exist in our top level collection? If Not CollectionContains(ThisCollection, key1) Then ' Key1 does not exist Set collection2 = New Collection Call ThisCollection.ADD(collection2, key1) End If Set collection2 = ThisCollection.Item(key1) ' Does element key2 exist in our second level collection? If Not CollectionContains(collection2, key2) Then ' Key2 does not exist Set collection3 = New Collection Call collection2.ADD(collection3, key2) End If Set collection3 = collection2.Item(key2) ' Does element key3 exist in our third level collection? If CollectionContains(collection3, key3) Then collection3.REMOVE key3 End If ' Add keySec/Value Call collection3.ADD(value, key3) End Sub Function GetValue(key1 As String, key2 As String, key3 As String, valueToReturnIfNotFound) As Variant key1 = UCase(key1) key2 = UCase(key2) key3 = UCase(key3) ' returns null if no found Dim collection2 As Collection Dim collection3 As Collection GetValue = valueToReturnIfNotFound ' Does element keyPri exist in our top level collection? If CollectionContains(ThisCollection, key1) Then Set collection2 = ThisCollection(key1) If CollectionContains(collection2, key2) Then Set collection3 = collection2(key2) ' Does element key3 exist in our third level collection? If CollectionContains(collection3, key3) Then GetValue = collection3(key3) End If End If End If End Function Function ElementExistsForKey1Key2(key1 As String, key2 As String) As Boolean key1 = UCase(key1) key2 = UCase(key2) ElementExistsForKey1Key2 = False Dim collection2 As Collection ' Does element keyPri exist in our top level collection? If CollectionContains(ThisCollection, key1) Then Set collection2 = ThisCollection(key1) If CollectionContains(collection2, key2) Then ElementExistsForKey1Key2 = True End If End If End Function Function ElementExistsForKey1Key2Key3(key1 As String, key2 As String, key3 As String) As Boolean key1 = UCase(key1) key2 = UCase(key2) key3 = UCase(key3) ElementExistsForKey1Key2Key3 = False Dim collection2 As Collection Dim collection3 As Collection ' Does element keyPri exist in our top level collection? If CollectionContains(ThisCollection, key1) Then Set collection2 = ThisCollection(key1) If CollectionContains(collection2, key2) Then Set collection3 = collection2(key2) If CollectionContains(collection3, key3) Then ElementExistsForKey1Key2Key3 = True End If End If End If End Function