Collection Object
 

Dan, was this helpful?

"Patrick Molloy" wrote:

no worries

Option Explicit

Sub test()
Dim cell As Range
Dim x As Class1
Dim col As Collection
Set col = New Collection
For Each cell In Range("A1:A10").Cells
Set x = New Class1
x.Count = 1
x.Item = cell.Value
On Error Resume Next
col.Add x, cell.Value
If Err.Number < 0 Then
Err.Clear
On Error GoTo 0
Set x = col.Item(cell.Value)
x.Count = x.Count + 1

End If

Next
Dim index As Long
For index = 1 To col.Count
Set x = col.Item(index)
Range("B1").Offset(index) = x.Item
Range("B1").Offset(index, 1) = x.Count

Next

End Sub


add a class module, Class1
and add these two lines


Public Item As String
Public Count As Long

'purpose to create a counter for ket values

"Dan" wrote:

Hi Patrick. Thanks for the reply. I should have mentioned that i was already
aware that dictionaries were available but that i wanted to know specifically
if collections are capable of doing what i asked...

I'm not against using the dicionary - i simply cant understand why i cant
alter a collection members value...

Ta

Dan

"Patrick Molloy" wrote:

can I suggest an alternative? The Scripting Runtime Dictionary is basically a
collection object with one or two useful features, for example you can check
it a ket exists or not, which means you don't need to trap errors.

In the development environment, under the menu Tools / References select the
Microsoft Scripting Runtime dll

try this code:

Option Explicit

Sub Collect()
Dim a As Range
Dim MyRange As Range
Dim dic As Scripting.Dictionary
Dim key As String
Set MyRange = Range("A1:A10")

Set dic = New Scripting.Dictionary
For Each a In MyRange
key = a.Value
If dic.Exists(key) Then
dic.Item(key) = dic.Item(key) + 1
Else
dic.Add key, 1
End If


Next a
' output
Dim index As Long
For index = 0 To dic.Count - 1
Range("B1").Offset(index) = dic.Keys(index)
Range("B1").Offset(index, 1) = dic.Items(index)
Next

End Sub


"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

Collection Object
 

Kind of. I'm not sure i understand what i'm doing though. i can get it to
work but not sure how it works...

"Patrick Molloy" wrote:

Dan, was this helpful?

"Patrick Molloy" wrote:

no worries

Option Explicit

Sub test()
Dim cell As Range
Dim x As Class1
Dim col As Collection
Set col = New Collection
For Each cell In Range("A1:A10").Cells
Set x = New Class1
x.Count = 1
x.Item = cell.Value
On Error Resume Next
col.Add x, cell.Value
If Err.Number < 0 Then
Err.Clear
On Error GoTo 0
Set x = col.Item(cell.Value)
x.Count = x.Count + 1

End If

Next
Dim index As Long
For index = 1 To col.Count
Set x = col.Item(index)
Range("B1").Offset(index) = x.Item
Range("B1").Offset(index, 1) = x.Count

Next

End Sub


add a class module, Class1
and add these two lines


Public Item As String
Public Count As Long

'purpose to create a counter for ket values

"Dan" wrote:

Hi Patrick. Thanks for the reply. I should have mentioned that i was already
aware that dictionaries were available but that i wanted to know specifically
if collections are capable of doing what i asked...

I'm not against using the dicionary - i simply cant understand why i cant
alter a collection members value...

Ta

Dan

"Patrick Molloy" wrote:

can I suggest an alternative? The Scripting Runtime Dictionary is basically a
collection object with one or two useful features, for example you can check
it a ket exists or not, which means you don't need to trap errors.

In the development environment, under the menu Tools / References select the
Microsoft Scripting Runtime dll

try this code:

Option Explicit

Sub Collect()
Dim a As Range
Dim MyRange As Range
Dim dic As Scripting.Dictionary
Dim key As String
Set MyRange = Range("A1:A10")

Set dic = New Scripting.Dictionary
For Each a In MyRange
key = a.Value
If dic.Exists(key) Then
dic.Item(key) = dic.Item(key) + 1
Else
dic.Add key, 1
End If


Next a
' output
Dim index As Long
For index = 0 To dic.Count - 1
Range("B1").Offset(index) = dic.Keys(index)
Range("B1").Offset(index, 1) = dic.Items(index)
Next

End Sub


"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

Collection Object
 

basically you've created your object from the class Class1, which has just
two properties,,,Item and Count

when you save to a collection, you save objects. Even simple text is an
object.
In your case, if the item, identified by its key, isn't in the collection,
you create a new object, set the object's two values, then save that into the
collection.
When a key exists, you set the variable (defined as the Class1 oblect) to
that item in the collection...whatever you then do to that variable is done
to the item in the collection..ie incrementing its count property.

this is somewhat simplistic, but if you aren't used to classes, it pretty
much covers the bases.
was this clearer? Play around with class module and play around at building
your own objects. it can be fun. Am i really that sad :(
;)



"Dan" wrote:

Kind of. I'm not sure i understand what i'm doing though. i can get it to
work but not sure how it works...

"Patrick Molloy" wrote:

Dan, was this helpful?

"Patrick Molloy" wrote:

no worries

Option Explicit

Sub test()
Dim cell As Range
Dim x As Class1
Dim col As Collection
Set col = New Collection
For Each cell In Range("A1:A10").Cells
Set x = New Class1
x.Count = 1
x.Item = cell.Value
On Error Resume Next
col.Add x, cell.Value
If Err.Number < 0 Then
Err.Clear
On Error GoTo 0
Set x = col.Item(cell.Value)
x.Count = x.Count + 1

End If

Next
Dim index As Long
For index = 1 To col.Count
Set x = col.Item(index)
Range("B1").Offset(index) = x.Item
Range("B1").Offset(index, 1) = x.Count

Next

End Sub


add a class module, Class1
and add these two lines


Public Item As String
Public Count As Long

'purpose to create a counter for ket values

"Dan" wrote:

Hi Patrick. Thanks for the reply. I should have mentioned that i was already
aware that dictionaries were available but that i wanted to know specifically
if collections are capable of doing what i asked...

I'm not against using the dicionary - i simply cant understand why i cant
alter a collection members value...

Ta

Dan

"Patrick Molloy" wrote:

can I suggest an alternative? The Scripting Runtime Dictionary is basically a
collection object with one or two useful features, for example you can check
it a ket exists or not, which means you don't need to trap errors.

In the development environment, under the menu Tools / References select the
Microsoft Scripting Runtime dll

try this code:

Option Explicit

Sub Collect()
Dim a As Range
Dim MyRange As Range
Dim dic As Scripting.Dictionary
Dim key As String
Set MyRange = Range("A1:A10")

Set dic = New Scripting.Dictionary
For Each a In MyRange
key = a.Value
If dic.Exists(key) Then
dic.Item(key) = dic.Item(key) + 1
Else
dic.Add key, 1
End If


Next a
' output
Dim index As Long
For index = 0 To dic.Count - 1
Range("B1").Offset(index) = dic.Keys(index)
Range("B1").Offset(index, 1) = dic.Items(index)
Next

End Sub


"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