Sorting a collection. *Leaving Duplicates*

[gimme_this_gimme_that@yahoo.com]

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, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

[Dave Peterson]

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



gimme_this_gimme_that@yahoo.com 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, before:=j
> NoDupes.Add Swap2, before:=i
> NoDupes.Remove i + 1
> NoDupes.Remove j + 1
> End If
> Next j
> Next i

--

Dave Peterson

[JMB]

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
>
>
>
> gimme_this_gimme_that@yahoo.com 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, before:=j
> > NoDupes.Add Swap2, before:=i
> > NoDupes.Remove i + 1
> > NoDupes.Remove j + 1
> > End If
> > Next j
> > Next i
>
> --
>
> Dave Peterson
>

[Dave Peterson]

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
> >
> >
> >
> > gimme_this_gimme_that@yahoo.com 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, before:=j
> > > NoDupes.Add Swap2, before:=i
> > > NoDupes.Remove i + 1
> > > NoDupes.Remove j + 1
> > > End If
> > > Next j
> > > Next i
> >
> > --
> >
> > Dave Peterson
> >

--

Dave Peterson

[gimme_this_gimme_that@yahoo.com]

Thanks guys.

All this is helpful.