Posted to microsoft.public.excel.programming
|
|
Sorting a collection. *Leaving Duplicates*
You're not missing anything. I was.
And John's code left the duplicates.
Thanks for the correction.
JMB wrote:
Dave - I tested the code the OP posted w/a collection that contained
duplicates and it seemed to work okay.
I often use collections to weed out duplicates, but usually I have to use
something like the following (I'm pretty sure I got this from the same source
the OP did-I don't think all the code was posted)
On Error Resume Next
For Each x in Selection
NoDupes.Add x.value, Cstr(x.value)
Next x
On Error Goto 0
where the second paremter, Cstr(x.value) is a key assigned to that
particular item in the collection (and since there can only be one unique key
an error is generated when you try to add a duplicate item to the collection,
so it gets skipped). If no key is assigned, I was able to add duplicate
items to a collection.
Is there something else I'm missing?
"Dave Peterson" wrote:
Collections don't allow duplicates.
Maybe just sorting an array is what you want?
Here's a sample version that looks a lot like John's code:
Option Explicit
Sub testme()
Dim myArr1 As Variant
Dim iCtr As Long
Dim jCtr As Long
Dim Temp As Variant
myArr1 = Array("S", "E", "A", "R", "C", "H")
For iCtr = LBound(myArr1) To UBound(myArr1) - 1
For jCtr = iCtr + 1 To UBound(myArr1)
If myArr1(iCtr) myArr1(jCtr) Then
Temp = myArr1(iCtr)
myArr1(iCtr) = myArr1(jCtr)
myArr1(jCtr) = Temp
End If
Next jCtr
Next iCtr
For iCtr = LBound(myArr1) To UBound(myArr1)
MsgBox iCtr & "--" & myArr1(iCtr)
Next iCtr
End Sub
wrote:
John Walkenbach uses the following code to sort a collection and to
remove duplicates.
Can it be modified to set a collection but to leave duplicates ?
Thanks.
' Using Walkenbach's NoDupes variable name eventhough duplicates are to
be preserved
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, befo=j
NoDupes.Add Swap2, befo=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
--
Dave Peterson
--
Dave Peterson
|