View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
dan dan is offline
external usenet poster
 
Posts: 866
Default 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