Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Sorting Collection

6 views
Skip to first unread message

David

unread,
Sep 6, 2006, 9:46:38 PM9/6/06
to
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

unread,
Sep 6, 2006, 10:23:24 PM9/6/06
to
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

unread,
Sep 6, 2006, 10:32:11 PM9/6/06
to
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

unread,
Sep 6, 2006, 10:36:57 PM9/6/06
to
Can you post the rest of the code please? Specifically how you dim the
Collection and get names into it.

Charles

David

unread,
Sep 6, 2006, 10:43:25 PM9/6/06
to
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

unread,
Sep 6, 2006, 10:47:05 PM9/6/06
to
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

unread,
Sep 6, 2006, 10:49:13 PM9/6/06
to
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

unread,
Sep 6, 2006, 11:24:36 PM9/6/06
to
That worked great. Thanks for your help.

-David

Die_Another_Day

unread,
Sep 6, 2006, 11:40:44 PM9/6/06
to
I notice that your collection was named nodupe, do you just want to
determine whether or not there was a duplicate?

Charles

Tom Ogilvy

unread,
Sep 7, 2006, 9:30:02 AM9/7/06
to
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.

--
Regards,
Tom Ogilvy

Die_Another_Day

unread,
Sep 7, 2006, 9:44:27 AM9/7/06
to
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

Tom Ogilvy

unread,
Sep 7, 2006, 4:28:02 PM9/7/06
to
sure, but he asked how to sort it - not check if there were duplicates.

David

unread,
Sep 7, 2006, 8:57:49 PM9/7/06
to
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

unread,
Sep 7, 2006, 11:46:17 PM9/7/06
to
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

--
Regards,
Tom Ogilvy


"David" <pick...@gmail.com> wrote in message
news:1157677069.6...@i42g2000cwa.googlegroups.com...

Die_Another_Day

unread,
Sep 8, 2006, 8:46:48 AM9/8/06
to
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

unread,
Sep 8, 2006, 10:34:44 PM9/8/06
to
Sorry to say but whenever I try to run that code excel crashes.

Die_Another_Day

unread,
Sep 9, 2006, 8:45:45 AM9/9/06
to
David, Try single stepping through the code and find out where it
crashes. What version of excel are you using?

Charles Chickering

Tom Ogilvy

unread,
Sep 9, 2006, 5:59:43 PM9/9/06
to
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

--
Regards,
Tom Ogilvy

"David" <pick...@gmail.com> wrote in message

news:1157769284.1...@d34g2000cwd.googlegroups.com...

David

unread,
Sep 10, 2006, 3:06:31 AM9/10/06
to
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

unread,
Sep 10, 2006, 2:34:01 PM9/10/06
to
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.

--
Regards,
Tom Ogilvy

"David" <pick...@gmail.com> wrote in message

news:1157871991....@h48g2000cwc.googlegroups.com...

David

unread,
Sep 10, 2006, 9:08:31 PM9/10/06
to
Nope as far as I know there's no refrence to word in my code. Thanks
for your help though.

- David

mahesh

unread,
Sep 28, 2006, 1:17:01 AM9/28/06
to

Hi,
I need to draw a pareto chart based on a list of values, which are
formula-driven.
First I need to sort the values, take the cumulative, calculate the
percentage and then plot a pareto chart.

As I know, excel doesn't allow sorting of formula-driven values.
So, effectively, I need some option, function or code which takes these
formula-driven values and sort them, so that I can plot a pareto chart

Please clarify.
Thanks and regards
Mahesh

Norman Jones

unread,
Sep 28, 2006, 1:54:29 AM9/28/06
to
Hi Mahesh,

Can you give an example of formula values which do not permit sorting?

---
Regards,
Norman

"mahesh" <mahesh....@gmail.com> wrote in message
news:1159420621.4...@h48g2000cwc.googlegroups.com...

mahesh

unread,
Sep 29, 2006, 5:41:11 AM9/29/06
to
Hi Norman,

It's not exactly "formula values do not permit sorting", but "sorting
doesn't take formula fields". For example, if you have a list of 5
values in column A. Take the cumulative, for each cell, in the adjacent
column B. And take the percentage of each value corresponding to the
total value and place them in column C

Now select all the columns and sort by column A.

The result will be that only Col A will be sorted and not the other
two.
It is understood that, when you are selecting all the columns, all the
values should align accoridngly with the sorted col.

Could I answer you?

Thanks
Mahesh

Curt

unread,
Jan 6, 2007, 1:11:00 PM1/6/07
to
Is it possible to adapt your code to sort a column in numerical sequence that
is 12345678 repeat 12345678 until entire column is sorted. I am new to
sorting so have tried all I can. Found no way in options to get sequence all
ways got 1122334455667788 needed 12345678
any way
Thanks
cag...@att.net

Tom Ogilvy

unread,
Jan 6, 2007, 2:33:42 PM1/6/07
to
in Column C put in this formula in the first row

=countif($B$1:B1,B1)

then drag fill down the column.

Select column C, do Edit=>Copy, then Edit=>Paste Special and select Values.

Now sort the data with column C as the first key, then column B as the
second key.

This is fairly trivial - make an effort. - pay attention to the
instructions.

--
Regards,
Tom Ogilvy

"Curt" <Cu...@discussions.microsoft.com> wrote in message
news:27D790BC-27F0-42F4...@microsoft.com...

Curt

unread,
Jan 6, 2007, 3:26:00 PM1/6/07
to
did follow also have tried int still get 1122334455667788 want 12345678 then
repeat till entire column sorted

Tom Ogilvy

unread,
Jan 6, 2007, 3:43:55 PM1/6/07
to
I see in another thread, you posted sample code that is sorting on column C,
but your original post said your data was in column B. You also appear to
want to sort the rows out to column t, so the information I gave you would
be put in column U and you would sort on U as your primary key.

=countif($C$1:C1,C1)


--
Regards,
Tom Ogilvy


"Tom Ogilvy" <twog...@msn.com> wrote in message
news:ulpxKmc...@TK2MSFTNGP06.phx.gbl...

Tom Ogilvy

unread,
Jan 6, 2007, 4:07:39 PM1/6/07
to
Either you haven't correctly described what you want to do, or you didn't
apply the solution properly.

for example, in your sample code you posted you do

for t = 2 to cells(100,3).End(xlup).Column step 8

cells(100,3).End(xlup).Column will always return 3, so your loop would
only do one pass.


you also select Range(Cells(t, 3), Cells(t + 3, 3)).Select

and then sort only the selection. This would sort C2:C5 on the one pass
you make, but you said you want to sort 8 cells. Also, it appears you want
to sort all the columns from A to T (you explanations are not that clear),
so you would not just sort column C alone.

I posted some corrections in that thread, but hopefully you can understand
that I don't particularly accept you answer that you triet it and it failed.
That may very well be, but it would work for the problem as I understood you
to described it (which may not be the problem).

--
Regards,
Tom Ogilvy

"Curt" <Cu...@discussions.microsoft.com> wrote in message

news:61C6E3FA-2568-475A...@microsoft.com...

Curt

unread,
Jan 6, 2007, 4:26:00 PM1/6/07
to
i caught onto the relationship of columns so it did sort. Only i am after a
sort of 12345678 not 111222333444555 this is my problem. need to sort into
groups of 8 repeated till column is sorted. the other post has had diferent
ways to try maybe i left some trial data in.

Tom Ogilvy

unread,
Jan 6, 2007, 4:57:54 PM1/6/07
to
If you want to send a sample workbook, I will set it up for you.

twog...@msn.com

--
Regards,
Tom Ogilvy


"Curt" <Cu...@discussions.microsoft.com> wrote in message

news:F6367ACD-A02B-4396...@microsoft.com...

Curt

unread,
Jan 6, 2007, 7:57:00 PM1/6/07
to
entry Helper 4
1 1 2 1 1
2 1 5 2 2
3 1 5 3 3
4 1 7 4 4
4 2 8 8 8
6 1 1 5 5
7 1 6 7 7
8 1 3 6 6
1 2 6 3 3
2 2 1 1 1
3 2 3 2 2
5 1 8 4 4
6 2 4 7 7
7 2 4 6 6
8 2 2 5 5
7 8 8

Here are a copy paste from a worksheet need the columns to sort 12345678. as
you can see I have been trying. So far no luch
Thanks

Tom Ogilvy

unread,
Jan 6, 2007, 8:52:21 PM1/6/07
to
Data value Qty
1 16
2 15
3 8
4 8
5 7
6 8
7 8
8 8

so you don't have an equal number of each value (1 to 8)

How do you want them sorted (assume the first 1 is in C2 for each case)

1 2 3 4 5
6 7 8 1 2
3 4 5 6 7

or
1 1
2 2
3 3
4 4
5 5
6 6
7 7
8 8
1 1
2 2
3 3
4 4
5 5
6 6
7 7
8 8

what to do about incomplete sets?

and, this cetainly doesn't match any of your descriptions or your code.

If you have complete sets, you might as well regenerate them
i = 0
for each cell in Range("C2").Resize(16,5)
i = i + 1
if i > 8 then i = 1
cell = i
Next


or

i = 0
for each cell in range("C2:C17")
i = i + 1
if i > 8 then i = 1
cell.Resize(1,5).Value = i
Next


--
Regards,
Tom Ogilvy


"Curt" <Cu...@discussions.microsoft.com> wrote in message

news:69241075-7D15-422D...@microsoft.com...

Curt

unread,
Jan 6, 2007, 11:43:01 PM1/6/07
to
in the column to be sorted needs to finish out at 12345678 / 12345678 until
it does the entire column. I am sure I can adjust for the columns if I have a
macro that will sort.
I've pulled my hair out what I have left !!!
Thanks Much

Curt

unread,
Jan 6, 2007, 11:45:00 PM1/6/07
to
Sorry didn"t get all sort is down a column not across a row
Thanks
Curt

Curt

unread,
Jan 6, 2007, 11:56:01 PM1/6/07
to
incomplete sets just are that incomplete 12345---
Thanks again

Tom Ogilvy

unread,
Jan 7, 2007, 12:43:36 AM1/7/07
to
Sub AAAA()
Dim cell As Range
Dim rng As Range
Dim rng1 As Range
For Each cell In Range("C2:G2")
Set rng = Range(cell, cell.End(xlDown))
cell.Offset(0, 1).EntireColumn.Insert
Set rng1 = cell.Offset(0, 1).Resize(rng.Count, 1)
rng1.Formula = "=Countif(" & rng(1).Address(1, 1) & _
":" & rng(1).Address(0, 0) & "," & _
rng(1).Address(0, 0) & ")"
rng1.Formula = rng1.Value
Range(cell, cell.Offset(0, 1)).Resize(rng.Count).Sort _
key1:=cell.Offset(0, 1), Order1:=xlAscending, _
key2:=cell, Order2:=xlAscending
cell.Offset(0, 1).EntireColumn.Delete
Next

End Sub

produced:

1 1 1 1 1
2 2 2 2 2
3 8 3 3 3
4 1 4 4 4
5 2 5 5 5
6 1 6 6 6
7 2 7 7 7
8 1 8 8 8
1 2 1 1 1
2 1 2 2 2
3 2 3 3 3
4 1 4 4 4
6 2 5 5 5
7 1 6 6 6
8 2 8 7 7
7 1 8


with your test data.

Use the method I originally advised, applied to the multicolumn layout of
your data and the statement (as I understood it) that you wanted each column
sorted separately. As I understand it, that is what you want.

--
Regards,
Tom Ogilvy


"Curt" <Cu...@discussions.microsoft.com> wrote in message

news:640AAFD1-9C78-4AE6...@microsoft.com...

Curt

unread,
Jan 7, 2007, 11:53:02 AM1/7/07
to
Many Thanks That is exactly what I needed. Sure do appreciate Your help
cag...@att.net

Curt

unread,
Jan 11, 2007, 7:36:00 PM1/11/07
to
your code works like a champ. I am not sure as to change it to sort one
column. It does give the sequence I wanted. will be useing 'd' as column in
data

Curt

unread,
Jan 14, 2007, 11:31:00 PM1/14/07
to
is there something I can add into "For Each cell In Range("C2")" to have it
disregard text in the cells. Would like to use a pull down menu for data
entry into the cell. Thanks it does the job extremely well. Once I relized it
stops where there blanks. With this new sheet there won't be any blanks.
Thanks Again
cag...@att.net

Curt

unread,
Jan 23, 2007, 1:04:01 PM1/23/07
to
Sort works beautifully can we modify to include. The row moving with the
sort. I need the rows a-m to move with the sort. Only need to sort on column
D all other columns are text. Data I sent you was befor I fully understood
what I needed. We can readjust to put data sort column where ever needed to
make it easier to write. Any column between A-M can be used. I can not get my
worksheet to copy into this reply. Does it matter if sort column has nbr
first then text :'1 cars' useing a pull down to insert catagorie.
Your assistance has been a blessing to me. My age I get into these problems
because younger ones don't want to accept responsibilty. Have to create a
program to stage parade so they push a button and get all printed out. Quite
a challenge. Just for FYI these is for Vet"s day parade.
Hope I have explained well enough. If not court marshall?
Have to keep some humor
Thanks again
cag...@att.net
0 new messages