Sorting Collection

[David]

I have a collection filled with names and I was wondering if someone
could show me some code to sort it alphabetically. Thanks

- David

 

[Die_Another_Day]

Here's a mix on some code from ozgrid. Note this is untested and
adapted from the original:
Dim MyCollection As New Collection
Dim lLoop As Long, lLoop2 As Long
Dim str1 As String
Dim str2 As String

'Sort array
For lLoop = 0 To MyCollection.Count
For lLoop2 = lLoop To MyCollection.Count
If UCase(MyCollection(lLoop2)) < UCase(MyCollection(lLoop))
Then
str1 = MyCollection(lLoop)
str2 = MyCollection(lLoop2)
MyCollection(lLoop) = str2
MyCollection(lLoop2) = str1
End If
Next lLoop2
Next lLoop

HTH

Charles Chickering

Here's the original website if you want to read it as well:
http://www.ozgrid.com/VBA/sort-array.htm

 

[David]

Thanks for the help, but when I tried that code I got a subscript out
of range error on this line:

If UCase(nodupes(lLoop2)) < UCase(nodupes(lLoop)) Then

any ideas why? Thanks.

- David

 

[Die_Another_Day]

Can you post the rest of the code please? Specifically how you dim the
Collection and get names into it.

Charles

 

[David]

Here you go.

On Error Resume Next
For g = 1 To 669
If ActiveSheet.Cells(g, 1) <> Empty Then
nodupes.Add ActiveSheet.Cells(g, 1).Value,
CStr(ActiveSheet.Cells(g, 1).Value)
Else
End If
Next g
On Error GoTo 0

Just for refrence the names are in the format last name, first name

-David

 

[Die_Another_Day]

I did a little more search and found this routine:
Public Sub SortCollection(ColVar As Collection)
Dim oCol As Collection
Dim i As Integer
Dim i2 As Integer
Dim iBefore As Integer
If Not (ColVar Is Nothing) Then
If ColVar.Count > 0 Then
Set oCol = New Collection
For i = 1 To ColVar.Count
If oCol.Count = 0 Then
oCol.Add ColVar(i)
Else
iBefore = 0
For i2 = oCol.Count To 1 Step -1
If LCase(ColVar(i)) < LCase(oCol(i2)) Then
iBefore = i2
Else
Exit For
End If
Next
If iBefore = 0 Then
oCol.Add ColVar(i)
Else
oCol.Add ColVar(i), , iBefore
End If
End If
Next
Set ColVar = oCol
Set oCol = Nothing
End If
End If
End Sub

Let me know if it works

Charles

 

[Die_Another_Day]

Anyhow I figured out the error for this one, Collections use Base 1 not
Base 0 so we need to change the first For loop
For lLoop = 1 to ....

Charles

 

[David]

That worked great. Thanks for your help.

-David

 

[Die_Another_Day]

I notice that your collection was named nodupe, do you just want to
determine whether or not there was a duplicate?

Charles

 

[Guest]

I suspect the OP is using some partial code taken from John Walkenbach's site
where a complete solution is presented.

http://www.j-walk.com/ss/excel/tips/tip47.htm
Filling a ListBox With Unique Items

Unless you do a major modification of someone else's code it is usually
better to provide the link so the complete context can be seen by the OP.

 

[Die_Another_Day]

Actually what I was getting at was possible using a dictionary instead
of a collection as it has an "Exist" Property. I though perhaps that
might speed things up for the OP. Have you ever used the Scripting
Dictionary before?

Charles

 

[Guest]

sure, but he asked how to sort it - not check if there were duplicates.

 

[David]

I am actually using the collection to remove duplicate items from a
list though I did not get the example I used from that site it was
similar. I've never used a scripting dictionary before and if it will
speed things up I'd love to hear about how it works. Thanks

- David

 

[Tom Ogilvy]

Set a reference to the Microsoft Scripting Runtime

then look in the object browser in the script library for the dictionary
object.

http://tinyurl.com/egu7o

 

[Die_Another_Day]

David, just to give you more specific instructions for VBA, Start by
opening the VBA Editor, Then goto Tools... References... and click the
checkbox for "Microsoft Scripting Runtime" then click "Ok"
Now use the following code:

Sub RemoveDupes()
Dim cnt As Long
Dim nodupes As Dictionary
Set nodupes = New Dictionary
For cnt = 1 To Range("C" & Rows.Count).End(xlUp).Row
If Not nodupes.Exists(CStr(ActiveSheet.Cells(cnt, 3).Value))
Then
nodupes.Add CStr(ActiveSheet.Cells(cnt, 3).Value), _
ActiveSheet.Cells(cnt, 3).Value
End If
Next
For cnt = 1 To nodupes.Count
Range("D" & cnt) = nodupes.Items(cnt - 1)
Next
End Sub

Let me know if you have problems

Charles

 

[David]

Sorry to say but whenever I try to run that code excel crashes.

 

[Die_Another_Day]

David, Try single stepping through the code and find out where it
crashes. What version of excel are you using?

Charles Chickering

 

[Tom Ogilvy]

by crashing, do you mean raises an error? If so

Try it this way

Sub RemoveDupes()
Dim cnt As Long
Dim nodupes As Scripting.Dictionary
Set nodupes = New Scripting.Dictionary
For cnt = 1 To Range("C" & Rows.Count).End(xlUp).Row
If Not nodupes.Exists(CStr(ActiveSheet.Cells(cnt, 3).Value)) Then
nodupes.Add CStr(ActiveSheet.Cells(cnt, 3).Value), _
ActiveSheet.Cells(cnt, 3).Value
End If
Next
For cnt = 1 To nodupes.Count
Range("D" & cnt) = nodupes.Items(cnt - 1)
Next
End Sub

if that is problematic, try it either of these ways:

Sub RemoveDupes()
Dim cnt As Long
Dim nodupes As Object
Set nodupes = CreateObject("Scripting.Dictionary")
For cnt = 1 To Range("C" & Rows.Count).End(xlUp).Row
If Not nodupes.Exists(CStr(ActiveSheet.Cells(cnt, 3).Value)) Then
nodupes.Add CStr(ActiveSheet.Cells(cnt, 3).Value), _
ActiveSheet.Cells(cnt, 3).Value
End If
Next
Range("D1").Resize(nodupes.Count, 1) = _
Application.Transpose(nodupes.Items)
End Sub


Sub RemoveDupes1()
Dim cnt As Long, v As Variant
Dim nodupes As Object
Set nodupes = CreateObject("Scripting.Dictionary")
For cnt = 1 To Range("C" & Rows.Count).End(xlUp).Row
If Not nodupes.Exists(CStr(ActiveSheet.Cells(cnt, 3).Value)) Then
nodupes.Add CStr(ActiveSheet.Cells(cnt, 3).Value), _
ActiveSheet.Cells(cnt, 3).Value
End If
Next
v = nodupes.Items
cnt = 1
For i = LBound(v) To UBound(v)
Range("D" & cnt).Value = v(i)
cnt = cnt + 1
Next

End Sub

 

[David]

I am using Excel 2003 and by crashing I mean that my computer freezes
until I press ctrl-alt-delete and end the process.

 

[Tom Ogilvy]

Do you have a reference to ms word in your references. Word also has a
dictionary object, but it isn't related to this one in the scriptiong
runtime. However, the code would look at the first instance of a dictionary
object in the reference list. That might be causing the crash. If that is
the case, then one of mine should fix that problem. If that isn't it, then
I am surprised that you would get such a problem.