VBA Collection - Changing Value of a Collection Item

HedgePig · Mar 16, 2006

Hello

I want to count the number of occurences of each unique value of a certain field I'm reading in. I don't know in advance what those unique values will be, so I thought I'd use collections rather than an array. I've set up two collection objects. The first simply has the field's value (of type string) added each time a new value is detected. The second stores a count of the number of occurences of that value. But I don't seem to be able to be able to change the value of this object within the collection. I guess I could delete it from the collection and then add it back in with value increased by one but that seems very clunky.

Do I just have the syntax wrong or am I trying to do something impossible. The last line of the code below generates a "Run-time error 424 - Object required"

Any suggestions?

Thanks
HedgePig

Code:

Dim SummaryCount as New Collection
Dim i as Long
Dim idxstr as String
.....

i =0
SummaryCount.Add i, key:=idxstr

.......
SummaryCount(idxstr) = SummaryCount(idxstr) + 1

'Produces an Error

acw · Mar 16, 2006

Hi

Here's an approach similar to yours that uses collections.

Create a new class module (insert Class Module) and insert the following

Public counta As Integer
Public item As String

Leave it as the default name of Class1.

You will have to adapt the following to cover your field readin process but hopefully you should get the idea.

Code:

Sub ccc()
 Dim nodupes As New Collection
 
 For Each ce In Range("a1:a9")
  Dim nodup As New Class1
  tester = ""
  On Error Resume Next
  tester = nodupes(ce.Value).item
  On Error GoTo 0
  If tester = "" Then
    nodup.counta = 1
    nodup.item = ce.Value
    nodupes.Add item:=nodup, key:=ce.Value
  Else
    nodup.counta = nodupes(ce.Value).counta + 1
    nodup.item = ce.Value
    nodupes.Remove (ce.Value)
    nodupes.Add item:=nodup, key:=ce.Value
 End If
  Set nodup = Nothing

 Next ce
 
 For Each ce In nodupes
   MsgBox ce.item & ", " & ce.counta
 Next ce
End Sub

I had the following data in the range A1:A9 (a,a,a,a,b,b,b,c,d). The results output were

a, 4
b, 3
c, 1
d, 1

HTH

Tony

HedgePig · Mar 17, 2006

Thanks for your post, Tony!

I like your idea of keeping everything (description and value) in one class, rather than maintaining two collections. However, you still have to remove the item from a collection to update and then add it back in again. I'd much prefer being able to directly update the object in the collection as I suspect this would be much quicker (although I may be wrong). So, do you know if there is anyway to directly access and alter an object while it's still part of a collection?

HedgePig

Legacy 98055 · Mar 17, 2006

"Run-time error 424 - Object required" Your are saving a value type, not an object type. VB collections are read only. They only "collect" and do not expose their own "value" property. However, for a reference type that contains write-access properties, you can overcome this limitation. In essence, the reference to your object is read-only but not the properties of the object being referenced. This may seem like a lot of overhead creating custom objects but it is not and will produce code that is much easier to read and maintain. The first example is for explanation only. See the code comments. See the second example for a better way to solve your problem using a custom made object. The following examples are for illustration only.

CustomTypeInCollection.zip

Both of the following examples use a custom class created by adding a class module and adding this line of code. Name this class "MyCustomType".

<table border="1" bgcolor="White"><caption ALIGN=left>Example VBA Code:</caption><tr><td> Public FieldCount As Long
</td></tr></table>

<table border="1" bgcolor="White"><caption ALIGN=left>Example VBA Code:</caption><tr><td> Sub Example()
 Dim SummaryCount As New Collection
 Dim idxstr As String

 'add three custom object that contain a single
 'public property, 1 as Long
 'assign 1, 2, and 3
 idxstr = "Key1"
 SummaryCount.Add GetInstance(1), key:=idxstr
 idxstr = "Key2"
 SummaryCount.Add GetInstance(2), key:=idxstr
 idxstr = "Key3"
 SummaryCount.Add GetInstance(3), key:=idxstr

 'output 1, 2, 3
 Debug.Print SummaryCount("Key1").FieldCount
 Debug.Print SummaryCount("Key2").FieldCount
 Debug.Print SummaryCount("Key3").FieldCount

 'add the custom objects value to it'self
 SummaryCount("Key1").FieldCount = SummaryCount("Key1").FieldCount + 1
 'assign a value straight-away
 SummaryCount("Key2").FieldCount = 3
 'assign a value straight-away
 SummaryCount("Key3").FieldCount = 4

 'output 2, 3, 4
 Debug.Print SummaryCount("Key1").FieldCount
 Debug.Print SummaryCount("Key2").FieldCount
 Debug.Print SummaryCount("Key3").FieldCount

 End Sub

 Private Function GetInstance(Value As Long) As MyCustomType
 Set GetInstance = New MyCustomType
 GetInstance.FieldCount = Value
 End Function

</td></tr></table>

<table border="1" bgcolor="White"><caption ALIGN=left>Example VBA Code:</caption><tr><td> Sub Example2()

 Dim SummaryCount As New Collection

 AddField "Field_Item_1", SummaryCount
 AddField "Field_Item_1", SummaryCount
 AddField "Field_Item_1", SummaryCount

 AddField "Field_Item_2", SummaryCount
 AddField "Field_Item_2", SummaryCount

 AddField "Field_Item_3", SummaryCount

 '3 occurrences
 Debug.Print SummaryCount("Field_Item_1").FieldCount
 '2 occurrences
 Debug.Print SummaryCount("Field_Item_2").FieldCount
 '1 occurrences
 Debug.Print SummaryCount("Field_Item_3").FieldCount

 End Sub

 Private Function AddField(Field As String, c As Collection) As MyCustomType
 On Error Resume Next
 Set AddField = c(Field)
 If AddField Is Nothing Then
 Set AddField = New MyCustomType
 AddField.FieldCount = 1
 c.Add AddField, Field
 Else
 AddField.FieldCount = AddField.FieldCount + 1
 End If
 End Function
</td></tr></table>

HedgePig · Mar 17, 2006

Thanks Right_Click! Your explanation "In essence, the reference to your object is read-only but not the properties of the object being referenced." is very helpful and your solution is exactly what I was looking for.

Interesting that this can be done with custom objects but not native types (integer, string, etc)

Many thanks again for the solution. It's precisely what I needed to know.

HedgePig

acw · Mar 19, 2006

HedgePig

The code from Right_Click prompted me. You can use my approach without the adding and removing entries in the collection. I did a quick test on approx 20000 records and the difference was about 1 second between the 2 methods.

Code:

Sub ccc()
 starttime = Now()
 
 Dim nodupes As New Collection
  
 For Each ce In Range("a1:a20000")
  Dim nodup As New Class1
  tester = ""
  On Error Resume Next
  tester = nodupes(ce.Value).item
  On Error GoTo 0
  If tester = "" Then
    nodup.counta = 1
    nodup.item = ce.Value
    nodupes.Add item:=nodup, key:=ce.Value
  Else
    'nodup.counta = nodupes(ce.Value).counta + 1
    'nodup.item = ce.Value
    'nodupes.Remove (ce.Value)
    'nodupes.Add item:=nodup, key:=ce.Value
    nodupes(ce.Value).counta = nodupes(ce.Value).counta + 1
 End If
  Set nodup = Nothing

 Next ce
  
 For Each ce In nodupes
   MsgBox ce.item & ", " & ce.counta
 Next ce
  
End Sub

Tony

HedgePig · Mar 20, 2006

Hello Tony

Thanks for that post. Actually it's pretty much exactly what I did after reading Right_Click's reply! Using this approach, it's easy to slot in any new "item" in alphabetic order which is nice.

I didn't time the differences between the two approaches though - interesting that there's not much time difference. I'm running through about 350,000 records in just over 30 seconds and it's not the newest of PC's, so it's pretty quick.

Thanks again
HedgePig

VBA Collection - Changing Value of a Collection Item

HedgePig

Board Regular

Excel Facts

acw

MrExcel MVP

HedgePig

Board Regular

Legacy 98055

Guest

HedgePig

Board Regular

acw

MrExcel MVP

HedgePig

Board Regular

Similar threads

Forum statistics

Share this page

VBA Collection - Changing Value of a Collection Item

HedgePig

Board Regular

Excel Facts

acw

MrExcel MVP

HedgePig

Board Regular

Legacy 98055

Guest

HedgePig

Board Regular

acw

MrExcel MVP

HedgePig

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock