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

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 - 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

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

Thanks guys.

All this is helpful.