You can do this with a class module. Insert a new Class named CMyObj
and paste in the following code:
'[CMyObj]
Public SName As String
Public Value As Long
Public Sub Increment()
Me.Value = Me.Value + 1
End Sub
Then, in Module1, use code like
'[Module1]
Dim MyColl As Collection
Sub AAA()
Dim R As Range
Dim Obj As CMyObj
Set MyColl = New Collection
For Each R In Range("A1:A10")
Set Obj = New CMyObj
Obj.SName = R.Text
Obj.Value = 1
On Error Resume Next
Err.Clear
MyColl.Add Item:=Obj, key:=R.Text
If Err.Number < 0 Then
'<<<<<<<<<
'MyColl(R.Text).Value = MyColl(R.Text).Value + 1
' OR
MyColl(R.Text).Increment
'<<<<<<<<<
End If
Next R
' list them out
For Each Obj In MyColl
Debug.Print Obj.SName, Obj.Value
Next Obj
End Sub
This creates an instance of CMyObj whose key in the Collection is the
text in cell R. If an object with that key does not exist in the
MyColl Collection, it is added. If it already exists, the item's Value
property is incremented. The code reads the Value out, increments it,
and writes it back. An alternative method is to put an Increment
method in the class an call that method to increment the Value.
The code marked with <<<< is most relevant to your question.
If you are new to classes, see
http://www.cpearson.com/excel/Classes.aspx.
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
On Thu, 10 Sep 2009 05:16:01 -0700, Dan
wrote:
I'd welcome your assistance with a little probem I'm having with the
Collection object.
I'm trying to utilise the fact that the Collection item's key must be a
unique value to obtain a collection of unique items in a Collection object.
If a try to add an item that already exists then VBA throws an error which i
handle and proceed.
What i'd like to do though is maintain a count of the number of each unique
item so as to obtain frequency of each unique item.
To do this I'm trying to increment the value of the item of the collection
by one each time an error is thrown:
On Error Resume Next
For Each a In myRange
myCol.Add 1,a
If Err.Number < 0 Then
'key exists so increment value by 1
myCol.Item(a) = myCol.Item(a)+ 1
End If
Err.Clear
Next a
On Error GoTo 0
They problem line of code is:
myCol.Item(a) = myCol.Item(a)+ 1
Does anyone know if i can actualy do what i'm trying to with the Collection
object?
Dan