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

Sorting (xl 97)

140 views
Skip to first unread message

Hans Knudsen

unread,
Apr 10, 1999, 3:00:00 AM4/10/99
to
I have data in cells A1:E35, and seek the easiest way to sort these data
ascending?

Hans Knudsen

DMcRitchie

unread,
Apr 10, 1999, 3:00:00 AM4/10/99
to
Hi Hans,

to sort on Column A for A1:E35 with no headers:
- select A1:E35
- Data --> Sort --> Column A / no headers /ascending

Since this is the programming group, same thing in a macro as generated by
Tools --> Macro --> Record

Sub Macro1()
Range("A1:E35").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
End Sub

Without headers the xlGuess above should be xlNo -- I tried it again and the
above is what was actually generated by my XL95.

HTH,
David McRitchie
My Excel Pages: http://members.aol.com/dmcritchie/excel/excel.htm

DMcRitchie

unread,
Apr 10, 1999, 3:00:00 AM4/10/99
to
I should've known there was a catch and a reason for not specifying a column to
be sorted. I'm attaching Han's email reply below. Perhaps someone else can
answer. Comma in use as decimal point (European style).

Of course that still leaves a question whether ascending left to right across
columns. Or ascending down one column then down the next. --- David

Hi David

Thank you David, but it seems to me that your proposals do not work. My data
is arranged as shown below. If I use your proposals I will have the numbers
sorted ascending column by column, but that wasn't my intention. What I want is
to have all numbers sorted ascending as if they appeared in one column only.

Regards
Hans

6,39 6,44 6,30 6,51 6,43 6,26
6,42 6,34 6,50 6,48 6,44 6,63
6,38 6,33 6,40 6,29 6,48 6,13
6,53 6,25 6,28 6,62 6,34 6,47
6,51 6,28 6,31 6,47 6,14 6,40
6,30 6,49 6,64 6,41 6,46 6,56
6,40 6,33 6,31 6,29 6,32 6,35
6,40 6,26 6,53 6,46 6,58 6,56
6,28 6,26 6,57 6,43 6,20 6,38
6,43 6,55 6,58 6,31 6,45 6,20
6,46 6,54 6,57 6,48 6,40 6,48
6,53 6,37 6,37 6,23 6,46 6,50
6,55 6,31 6,48 6,59 6,24 6,48
6,29 6,37 6,46 6,43 6,39 6,38
6,24 6,33 6,51 6,38 6,51 6,44
6,34 6,54 6,29 6,32 6,52 6,29
6,54 6,32 6,42 6,42 6,62 6,27
6,66 6,52 6,69 6,28 6,44 6,40
6,43 6,39 6,60 6,32 6,20 6,24
6,42 6,62 6,31 6,39 6,29 6,52
6,38 6,40 6,38 6,55 6,50 6,35
6,34 6,23 6,46 6,52 6,45 6,40
6,57 6,45 6,52 6,33 6,32 6,38
6,26 6,47 6,38 6,34 6,43 6,34
6,33 6,56 6,41 6,33 6,43 6,45
6,43 6,42 6,18 6,40 6,37 6,59
6,50 6,45 6,61 6,48 6,38 6,35
6,44 6,32 6,36 6,58 6,46 6,50
6,53 6,44 6,39 6,54 6,41 6,37
6,48 6,58 6,45 6,40 6,42 6,51
6,48 6,50 6,40 6,39 6,39
6,34 6,36 6,28 6,38 6,35
6,36 6,40 6,37 6,32 6,58
6,43 6,41 6,45 6,51 6,57

Iwer Mørck

unread,
Apr 10, 1999, 3:00:00 AM4/10/99
to
Try this:

Sub Macro1()
For i = 1 To 5
rng = Range(Cells(1, i), Cells(35, i)).Address
Range(rng).Sort Key1:=Cells(1, i), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
Next
End Sub


--
Cheers

Iwer Moerck

iwer....@get2net.dk


DMcRitchie skrev i meddelelsen
<19990410170629...@ng-fp1.aol.com>...

Rob Bovey

unread,
Apr 10, 1999, 3:00:00 AM4/10/99
to
Hi Hans,

Record a macro using the Data/Sort menu. With a little cleaning up you
can plug it right into your code.

--
Rob Bovey, MCSE
The Payne Consulting Group
http://www.payneconsulting.com
* Post follow up questions to this newsgroup *
* I do not respond to questions sent via e-mail *

Hans Knudsen wrote in message <7eo0b4$m4c$1...@news.inet.tele.dk>...


>I have data in cells A1:E35, and seek the easiest way to sort these data
>ascending?
>

>Hans Knudsen
>
>

PhilCxn

unread,
Apr 11, 1999, 3:00:00 AM4/11/99
to
<< I have data in cells A1:E35, and seek the easiest way to sort these data
ascending? >>

It sounds like your looking for something like this. Let me know if it does the
trick.

Sub PutInOrder()

Dim x As Integer
Dim y As Integer
Dim Done As Boolean

Do
Done = True
With Range("A1:E35")
For x = 1 To .Columns.Count
For y = 1 To .Rows.Count
.Rows(y).Select
Selection.Sort Key1:=.Rows(y).Cells(1), Header:=xlNo,
Order1:=xlAscending, Orientation:=xlLeftToRight
Next y
.Columns(x).Select
Selection.Sort Key1:=.Cells(1, x), Header:=xlNo,
Order1:=xlDescending, Orientation:=xlTopToBottom
Next x
For x = 1 To .Columns.Count
.Columns(x).Select
Selection.Sort Key1:=.Cells(1, x), Header:=xlNo,
Order1:=xlAscending, Orientation:=xlTopToBottom
If x > 1 Then
If Done Then Done = (.Cells(1, x) >= .Cells(.Rows.Count, x
- 1))
End If
Next x
End With
Loop While Not Done
Range("A1").Select
End Sub

PhilCxn

unread,
Apr 11, 1999, 3:00:00 AM4/11/99
to
<< I have data in cells A1:E35, and seek the easiest way to sort these data
ascending? >>


This is faster if it works with your numbers.

Sub InOrder()

Dim NumArray() As Double
Dim NumRows As Integer
Dim NumCells As Integer


Dim x As Integer
Dim y As Integer

Dim z As Integer

With Range("A1:E35")

NumRows = .Rows.Count
NumCells = .Cells.Count

ReDim NumArray(1 To NumCells)

For x = 1 To NumCells
NumArray(x) = .Cells(x)
Next x
End With
Do
y = y + 1
For x = 1 To NumRows
z = z + 1
Do While Application.Small(NumArray(), z) = 0
z = z + 1
Loop
Cells(x, y) = Application.Small(NumArray(), z)
If z = NumCells Then Exit For
Next x
Loop While z < NumCells
End Sub

Hans Knudsen

unread,
Apr 11, 1999, 3:00:00 AM4/11/99
to
PhilCxn and Iwer

I may be doing something wrong but I can't get any of your proposals to
work.

PhilCxn, Sub InOrder() I get a dark blue pattern after this code line:
NumCells = .Cells.Count

and the error message Sub or Function procedure not defined. The same for
the one changed for xl 97.


PhilCxn, Put InOrder() Dim x As Integer, This code line appear in dark
blue and I get the error message: Syntax error


Iwer, Macro1() For i = 1 To 6, This code line appear in dark blue and
I get the error message: Syntax error

Regards

Hans


PhilCxn

unread,
Apr 11, 1999, 3:00:00 AM4/11/99
to
I don't know what the problem is but I suggest you try a few thing.

In Sub InOrder()
1) delete the line with the problem and retype it in exactly the same and try
it again. If another line shows a problem do the same thing.

In Sub PutInOrder()
1) Again, delete the line and retype it in and try again.
2) If that doesn't work, remove all the Dim lines and try it again.

Let me know if that helps.
Phil.

Iwer Mørck

unread,
Apr 11, 1999, 3:00:00 AM4/11/99
to
Hans

I think you have the same annoying problem as I do. When I copy some code
like this one:

Sub Macro1()
For i = 1 To 5
rng = Range(Cells(1, i), Cells(35, i)).Address
Range(rng).Sort Key1:=Cells(1, i), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
Next
End Sub

from Outlook Express, the blanks, that appear to be spaces, are in fact
ASCII 160 characters. They cause a syntax error.

Try to remove them all, so it looks like this:

Sub Macro1()
For i = 1 To 5
rng = Range(Cells(1, i), Cells(35, i)).Address
Range(rng).Sort Key1:=Cells(1, i), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
Next
End Sub

A bit harder to read, but...

--
Hyg dig

Iwer Moerck

iwer....@get2net.dk

Hans Knudsen skrev i meddelelsen
>PhilCxn and Iwer
>
>bla.. bla..


>
>Iwer, Macro1() For i = 1 To 6, This code line appear in dark blue
and
>I get the error message: Syntax error
>
>Regards
>
>Hans
>


For i = 1 To 5, actually

Leo Heuser

unread,
Apr 11, 1999, 3:00:00 AM4/11/99
to
Hej Hans,

Try this code, which I sent to the group back in December.

'Sorts a range
'If the range is surrounded by blanks, select a cell
'in the range, else select the range.
'You have a choice of overwriting the original range
'(If you have formulas in there, they are overwritten!!)
'or placing the sorted range somewhere else on the sheet.
'Leo Heuser, december 1998

Sub SortRange()
Dim nArray() As Variant
Dim NumberOfRows As Long, NumberOfColumns As Long, i As Long
Dim rRow As Long, cColumn As Long, nNumber As Long, dummy, mMessage
Dim ByRow As Boolean, SortAscending As Boolean
Dim BufferCell As Range, DestCell As Range
Dim OriginalRegion As Range
Dim BufferRegion As Range
Dim DestRegion As Range

'Set to False if result is to be shown by columns
ByRow = True
'Set to False for sort to be descending
SortAscending = True

'The last column in the sheet is used as a buffer
Set BufferCell = Range("IV1")
rRow = BufferCell.Row
cColumn = BufferCell.Column
If Selection.Cells.Count = 1 Then
Set OriginalRegion = ActiveCell.CurrentRegion
Else
Set OriginalRegion = Selection
End If
NumberOfRows = OriginalRegion.Rows.Count
NumberOfColumns = OriginalRegion.Columns.Count
Set BufferRegion = BufferCell.Resize(NumberOfRows * NumberOfColumns, 1)
If ByRow = True Then
nNumber = NumberOfRows
Else
nNumber = NumberOfColumns
End If
If Application.WorksheetFunction.CountA(BufferRegion) <> 0 Then
dummy = "The buffer range is not empty." & Chr(13) & "Overwrite buffer range?"
mMessage = MsgBox(dummy, 308)
If mMessage = vbNo Then Exit Sub
End If
Set DestCell = Application.InputBox(prompt:="Enter destination cell", Default:=OriginalRegion(1, 1).Address, Type:=8)
Set DestRegion = DestCell.Resize(NumberOfRows * NumberOfColumns, 1)
If DestCell.Address <> OriginalRegion(1, 1).Address Then
If Application.WorksheetFunction.CountA(DestRegion) <> 0 Then
dummy = "The destination range is not empty." & Chr(13) & "Overwrite destination range?"
mMessage = MsgBox(dummy, 308)
If mMessage = vbNo Then Exit Sub
End If
Else
mMessage = MsgBox("Overwrite original range?", 308)
If mMessage = vbNo Then Exit Sub
End If
ReDim nArray(NumberOfRows)
Application.ScreenUpdating = False
For i = 0 To NumberOfRows - 1
OriginalRegion.Offset(i, 0).Resize(NumberOfRows - i, NumberOfColumns).Select
nArray(i) = Selection
Range(Cells(NumberOfColumns * i + rRow, cColumn), Cells(NumberOfColumns * i + rRow + NumberOfColumns - 1, cColumn)) =
Application.Transpose(nArray(i))
Next i
If SortAscending = True Then
BufferRegion.Sort key1:=BufferRegion(1, 1), order1:=xlAscending
Else
BufferRegion.Sort key1:=BufferRegion(1, 1), order1:=xlDescending
End If
For i = 0 To nNumber - 1
If ByRow = True Then
DestRegion.Offset(i, 0).Resize(NumberOfRows - i, NumberOfColumns) =
Application.Transpose(BufferRegion.Offset(NumberOfColumns * i, 0).Resize(NumberOfColumns, 1))
Else
DestRegion.Offset(0, i).Resize(NumberOfRows, NumberOfColumns - i) =
Application.Transpose(Application.Transpose(BufferRegion.Offset(NumberOfRows * i, 0).Resize(NumberOfRows, 1)))
End If
Next i
BufferRegion.ClearContents
DestRegion(1, 1).Activate
Application.ScreenUpdating = True
End Sub

Med venlig hilsen
Leo


Hans Knudsen skrev i meddelelsen <7eo0b4$m4c$1...@news.inet.tele.dk>...


>I have data in cells A1:E35, and seek the easiest way to sort these data
>ascending?
>

>Hans Knudsen
>
>

DMcRitchie

unread,
Apr 11, 1999, 3:00:00 AM4/11/99
to
In my XL95 the following statement fails in Leo's reply with Run-time error
438. Object doesn't support this property or method. Any slight modification
for this running on XL95 or is this strictly something requiring XL97.

If Application.WorksheetFunction.CountA(BufferRegion) <> 0 Then

The complete text of Leo's reply is in
http://www.dejanews.com/getdoc.xp?AN=464836683

Where he repeated part (3) of a more comprehensive posting from Dec 1998
presented as a Christmas present.
http://www.dejanews.com/getdoc.xp?AN=424453983&fmt=raw
1. Transferring a n*m range to a n*1 or 1*m range.
2. Transferring a n*m range to a m*n range
3. Sorting a range showing the result by rows or by columns. The result is
placed in the original range or elsewhere on the sheet.

This has been an interesting thread with different interpretations of a
question and different answers.
http://www.dejanews.com/getdoc.xp?AN=464836683

PhilCxn

unread,
Apr 11, 1999, 3:00:00 AM4/11/99
to
<< If Application.WorksheetFunction.CountA(BufferRegion) <> 0 Then >>


For XL95 Change to:

If Application.CountA(BufferRegion) <> 0 Then


David J. Braden

unread,
Apr 12, 1999, 3:00:00 AM4/12/99
to Hans Knudsen
Hans,
There was a thread some time back that dealt with this. One problem you have is
in problem specification: As Paul Sampson pointed out, "sort" doesn't make sense
in a tableau without further constraints.

Myrna Larson and I worked up the following, using ideas from Tom Ogilvy and Leo Heuser:
Sub SortInPlace1(rData As Range)
'Takes a table, rData, and sorts it from min to max, replacing
'rData row-wise. I.e., min is in r1,c1, next lowest in r1,c2, etc.
'This is SLOW for large tables. Much better to use a DLL for the sort
'Also, this approach is limited to tables of no more than cMaxElements elements.
Const cMaxElements = 4094
Dim iR As Integer, iC As Integer, iT As Integer
Dim rT As Variant

If rData.Rows.Count * rData.Columns.Count > cMaxElements Then
MsgBox _
"Sorry, but your table is too large for this routine to handle"
Exit Sub
End If

Application.ScreenUpdating = False
iT = 0
rT = rData.Value
For iR = 1 To rData.Rows.Count
For iC = 1 To rData.Columns.Count
iT = iT + 1
rData.Cells(iR, iC).Value = Application.Small(rT, iT)
Next
Next


Application.ScreenUpdating = True
End Sub

Myrna later worked up the following idea; more verbose, but **much** faster for
large tables. To speed it up still more, search dejanews.com for posts I made a
few months back on quicksort routines. If you want to do the quicksort in VBA,
then what I posted is the fastest I know of.

Sub SortInPlace3(rData As Range)
Const cMaxElements = 4094

Dim NumRows As Integer, NumCols As Integer, NumElems As Integer
Dim iR As Integer, iC As Integer, iT As Integer
Dim rT As Variant
Dim aSorted() As Double

Application.ScreenUpdating = False

NumRows = rData.Rows.Count
NumCols = rData.Columns.Count
NumElems = NumRows * NumCols
If NumRows * NumCols > cMaxElements Then
MsgBox _
"Sorry, but your table is too large for this routine to handle"
Exit Sub
End If

ReDim aSorted(1 To NumElems)
iT = 0
rT = rData.Value
For iR = 1 To NumRows
For iC = 1 To NumCols
iT = iT + 1
aSorted(iT) = rT(iR, iC)
Next iC
Next iR

QuickSort2 aSorted(), 1, NumElems

iT = 0
For iR = 1 To NumRows
For iC = 1 To NumCols
iT = iT + 1
rT(iR, iC) = aSorted(iT)
Next iC
Next iR
rData = rT


Application.ScreenUpdating = True
End Sub

Sub QuickSort2(List() As Double, ByVal Min As Long, ByVal Max As Long)
'Rod Stephens' version: slightly faster than "standard"
Dim Med_Value As Double
Dim Hi As Long
Dim Lo As Long
Dim i As Long

If Max <= Min Then Exit Sub

i = Int((Max - Min + 1) * Rnd + Min)
Med_Value = List(i)
List(i) = List(Min)

Lo = Min
Hi = Max
Do
Do While List(Hi) >= Med_Value
Hi = Hi - 1
If Hi <= Lo Then
List(Lo) = Med_Value
GoTo QSDone
End If
Loop

List(Lo) = List(Hi)
Lo = Lo + 1
Do While List(Lo) < Med_Value
Lo = Lo + 1
If Lo >= Hi Then
Lo = Hi
List(Hi) = Med_Value
GoTo QSDone
End If
Loop
List(Hi) = List(Lo)
Loop

QSDone:
QuickSort2 List(), Min, Lo - 1
QuickSort2 List(), Lo + 1, Max
End Sub


Another approach:
Suppose your data are in A1:E35. Somewhere on your sheet select a table of cells
that has the same number of rows and columns as the source data. Go the function
bar and type in (or cut and copy from here)

=SMALL(A1:E35,1+COLUMN(A1:E35)-INDEX(COLUMN(A1:E35),1)+COLUMNS(A1:E35)
*(ROW(A1:E35)-INDEX(ROW(A1:E35),1)))

all on one line. Hold Ctrl-Shift and press Enter. You'll see curly braces
appear around the formula, indicating it's an Array formula. You'll have your
sorted array in tabular form. Better yet, define a name (e.g., "TMY" or
"EdvardMunch" or "KnutHamsun") to be the range, and substitute it in the formula above.

For small arrays, all solutions are about as fast as one another. Obviously the
latter is the simplest. But if you get into recursion, consider the others,
especially Myrna's solution.

HTH
Dave Braden
TMY Research

0 new messages