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

Sorting Dilemma - Is this possible

2 views
Skip to first unread message

John Wilson

unread,
Feb 10, 2003, 9:58:43 AM2/10/03
to
I'm not sure if this can be done but it can't hurt to ask.

I have two workbooks and I import a list of names from one to the
other and vice versa. I need to keep them in sync for editing purposes.

I'm using the following code to populate a combobox on one of the
worksheets. The code itself works well, but by the act of sorting the
list it puts the lists out of sync.

My question is if there is any way to accomplish what I'm doing below
without a hard sort?
i.e.
copy the list to a variable (whatever), sort it, populate my combobox
but leave the
original list unscathed.

Code follows...

Thanx,
John

Application.Goto Reference:="NameList"
Selection.Sort Key1:=Range("C6"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Dim Name As Range
For Each Name In Worksheets("Data").Range(Range("C6"), _
Range("C65536").End(xlUp))
cbName.AddItem Trim(Name.Value) _
& " - " & Name.Offset(0, -1).Value _
& " - " & Name.Offset(0, 2).Value _
& " - " & Name.Offset(0, 3).Value
Next Name

Tom Ogilvy

unread,
Feb 10, 2003, 10:19:01 AM2/10/03
to
I may not understand what you want, but it sounds like you want John
Walkenbachs

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

At least that should give you some ideas.


Regards,
Tom Ogilvy


"John Wilson" <jwi...@optonline.net> wrote in message
news:3E47BE23...@optonline.net...

John Wilson

unread,
Feb 10, 2003, 10:32:06 AM2/10/03
to
Tom,

I actually use a portion of that j-walk routine in another part of this
project.
It works quite well but the sort routine takes a little longer than I'd like.

My workaround for my dilemma would be to copy my list to another sheet,
sort it, populate my combobox and then delete that copied list (leaving my
original list intact).

Was just wondering if there was a better way???
If there isn't, I'll just use the workaround.

Thanks,
John

Tom Ogilvy

unread,
Feb 10, 2003, 11:32:45 PM2/10/03
to
There are many faster sorting algorithms. I have posted them many times.

Search Result 1
From: Thomas Ogilvy (twog...@email.msn.com)
Subject: Re: VBA-Sorting an array
View: Complete Thread (3 articles)
Original Format
Newsgroups: microsoft.public.excel.programming
Date: 1999/05/30


Jim Rech posted this code sometime ago:

Sub Example()
Dim TheList As Variant
With DialogSheets("Dialog1").ListBoxes("List Box 4")
TheList = .List
QuickSort TheList, 1, .ListCount
.List = TheList
End With
End Sub

Sub QuickSort(SortArray, L, R)
Dim i, j, X, Y
i = L
j = R
X = SortArray((L + R) / 2)

While (i <= j)
While (SortArray(i) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j) And j > L)
j = j - 1
Wend
If (i <= j) Then
Y = SortArray(i)
SortArray(i) = SortArray(j)
SortArray(j) = Y
i = i + 1
j = j - 1
End If
Wend
If (L < j) Then Call QuickSort(SortArray, L, j)
If (i < R) Then Call QuickSort(SortArray, i, R)
End Sub

This code was posted by David Braden:
I believe David asked that the comments included be retained in any use of
the code.

Sub ShellSort(list As Variant, Optional ByVal LowIndex As Variant, Optional
HiIndex As Variant)
'Translation of Shell's Sort as described in
' "Numerical Recipes in C", 2nd edition, Press et al.
'For large arrays, consider Quicksort. This algorithm is at least
'as good up to about 100 or so elements. But with 500 randomized
'elements it is about 27% slower than QSort, and looks
'increasingly worse as the array size increases.

'Dec 17, '98 - David J. Braden

Dim i As Long, j As Long, inc As Long
Dim var As Variant

If IsMissing(LowIndex) Then LowIndex = LBound(list)
If IsMissing(HiIndex) Then HiIndex = UBound(list)
inc = 1
Do While inc <= HiIndex - LowIndex: inc = 3 * inc + 1: Loop
Do
inc = inc \ 3
For i = LowIndex + inc To HiIndex
var = list(i)
j = i
Do While list(j - inc) > var
list(j) = list(j - inc)
j = j - inc
If j <= inc Then Exit Do
Loop
list(j) = var
Next
Loop While inc > 1
End Sub

---------------------

for a two dimensional array: (single key)

From: Tom Ogilvy (twog...@msn.com)
Subject: Re: Sort values in a listbox
View: Complete Thread (9 articles)
Original Format
Newsgroups: microsoft.public.excel.programming
Date: 2002-12-09 19:46:43 PST


While John's article is excellent and I use it all the time, I am not sure
it is easily converted to sort a two-D array on the third column - well, it
wouldn't be hard, but it also wouldn't be very efficient. Here is a routine
you might want to try:


As to sorting on a specific column, I modified a quicksort routine
originally posted by Jim Rech to do that:

(the example routine at the bottom which calls the quicksort routine
specifies column 5 as the sort column)

since the col argument is used like this: SortArray(Array, col to sort,
LowerBound, Upperbound, bAscending)
then the 5 would be the sixth column in a zero based array and the 5th in a
1's based array.

Error checking is left as an exercise for the user.


Sub QuickSort(SortArray, col, L, R, bAscending)
'
'Originally Posted by Jim Rech 10/20/98 Excel.Programming
'Modified by T Ogilvy to sort on first column of a two dimensional array
'Modified by T Ogilvy to handle a a second dimension greater than 1 (or
zero)
'Modified by T Ogilvy to do Ascending or Descending
Dim i, j, X, Y, mm

i = L
j = R
X = SortArray((L + R) / 2, col)
If bAscending Then
While (i <= j)
While (SortArray(i, col) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, col) And j > L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
Else
While (i <= j)
While (SortArray(i, col) > X And i < R)
i = i + 1
Wend
While (X > SortArray(j, col) And j > L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
End If
If (L < j) Then Call QuickSort(SortArray, col, L, j, bAscending)
If (i < R) Then Call QuickSort(SortArray, col, i, R, bAscending)
End Sub


Sub aaTesterSort()
Dim bAscending As Boolean
Set rng = Range("I7").CurrentRegion
vArr = rng.Value
bAscending = False
QuickSort vArr, 5, LBound(vArr, 1), UBound(vArr, 1), bAscending
Range("I26").Resize(UBound(vArr, 1), UBound(vArr, 2)).Value = vArr
End Sub

Regards,
Tom Ogilvy

John Wilson <jwi...@optonline.net> wrote in message

news:3E47C5F6...@optonline.net...

John Wilson

unread,
Feb 10, 2003, 11:50:54 PM2/10/03
to
Tom,

Many thanks for the detailed reply.
I guess I need to do a better job with my Google searches.

I did get it to work the hard way by duplicating the range
somewhere else and although it's fast, I don't like doing it
that way (and it's a lot more prone to causing other problems
down the line).

With the type of data that I'm working with, I run into having
to do "hard" sorts in a number of different places. I'm sure one
(or more) of the examples you gave me will work better than
what I'm doing now. This was the first instance where I needed
to "undo" a "hard" sort.

I'll try the examples that you gave me here and whichever one
proves to be the fastest and get the job done is the one that
I'll use to replace what I have.

Thanks again,
John

0 new messages