Trouble with Arrays / Collections

[John]

Hi there,

I'm trying to get my head around multi-dimensional collections.

What I'm trying to do is to run through a column of data and check if each
cell value is "correct" (through some other logic). If it is not correct
then I want to add the value (string) to a collection and its associated
cell reference.
I'm assuming thus far that I need a 2 dimensional collection?

Now, if further down the column I come across the same incorrect string, I
want to find the existing collection item and add another cell reference to
it.

So (where "Bob" and "Mary" are NOT "correct"):

Bob
Mary
Susan
Bob

Would therefore be added to the collection as:

Item 1 ("Bob", "A1")
Item 2 ("Mary", "A2")
Item 1 ("Bob", "A1" & "A2")

Can anyone help me get this sorted out?

Thanks in advance

John

PS - The reason that I'm trying to use a collection rather than an array is
that I'm assuming that it's easier to reference the elements by name
(string)? I happy to be corrected!

 

[Tom Ogilvy]

Sub RemoveDuplicates()
Dim Rng As Range, Cell As Range
Dim List As New Collection
Dim v As Variant
Dim item As Variant

' The items are in A1:A10
Set Rng = Range("A1:A10")

On Error Resume Next
For Each Cell In Rng
v = List.item(Cell.Text)
Debug.Print Cell.Address, Err.Number
If Err.Number <> 0 Then
v = Array(Cell.Text, Cell.Address(0, 0))
List.Add v, CStr(Cell.Value)
Else
v(1) = v(1) & "," & Cell.Address(0, 0)
List.Remove Cell.Text
List.Add v, CStr(Cell.Value)
End If
Err.Clear
Next Cell

' Resume normal error handling
On Error GoTo 0


' Print out the list is the Immediate window
For Each item In List
v = item
Debug.Print v(0), v(1)
Next item


End Sub

 

[John]

Hello Tom,

Thanks very much for this. It works perfectly, although I need to study it
a bit longer to understand all the steps.

One questions though - why is the error handling necessary?

Anyway, great solution.

Thanks again

John

 

[Tom Ogilvy]

because if I try to access a member of a collection and that member doesn't
exist, then it raises an error. That is how I know the member doesn't
exist and can take the appopriate action.

 

[Guest]

This code sample skips the test for "correctness" but shows how you could use
a collection:
Public Sub CollectErrors(MyRange as Range)
Dim ErrCells As Collection, MyCell as Range
Dim OldRange As Range

Set ErrCells = New Collection
For each MyCell in MyRange.Cells
On Error GoTo Exists
ErrCells.Add MyCell, MyCell.Value ' this line will error if collection
already contains MyCell.Value
Next i

Exit Sub

Exists: ' If collection item already exists, remove it and replace it with
updated range consisting of the old range unioned with the current cell being
checked
Set OldRange = ErrCells(MyCell.Value)
ErrCells.Remove MyCell.Value
ErrCells.Add Union(OldRange, MyCell), MyCell.Value
Resume Next

End Sub

 

[John]

Great. Thanks Tom.

because if I try to access a member of a collection and that member
doesn't
exist, then it raises an error. That is how I know the member doesn't
exist and can take the appopriate action.

 

[Tom Ogilvy]

If you don't want to use the range reference to go back and retrieve the
value of the cells stored in the collection (which it what you seemed to
indicate), then one difference is that you can't retrieve the value of the
index which is where it stores the value of the cell. Unlike built in
collections, user define collections don't have a name property. Or perhaps
KL knows a way to do it.


--
Regards,
Tom Ogilvy

 

[John]

Hi Tom,

Well my original thought was that each multiple cell reference would be a
separate item, but the range method (and concatenation) works fine. (I'm
able to split the second part and get the references back later on.)

The "re-dimensioning" question is really for future reference. Can you
point me towards any useful web references on using collections (I mean
apart from the standard MS stuff)?

I must say that I find arrays / collections conceptually quite challenging
(no doubt obvious to everyone else ).

Anyway thanks again for you fast response.

Best regards

John

 

[DM Unseen]

Tom,

you could also try the "Dictionary" attack. It needs a reference to the
windows scripting runtime to work:

Sub RemoveDuplicates()
Dim Rng As Range, Cell As Range
Dim List As New Dictionary
Dim i As Integer

' The items are in A1:A10
Set Rng = Application.Range("B2:B20")

For Each Cell In Rng
With Cell
If List.Exists(.Value) Then
List(.Value) = List(.Value) & "," & .Address(0, 0)
Else
List.Add .Value, .Address(0, 0)
End If
End With
Next Cell

' Print out the list is the Immediate window

For i = 0 To List.Count - 1
Debug.Print List.Items()(i), List.Keys()(i)
Next i

End Sub

Dm Unseen