Sorting (xl 97)
Hans Knudsen
ascending?
Hans Knudsen
DMcRitchie
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
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
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
DMcRitchie skrev i meddelelsen
<19990410170629...@ng-fp1.aol.com>...
Rob Bovey
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
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
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
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
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
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
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
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
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
For XL95 Change to:
If Application.CountA(BufferRegion) <> 0 Then
David J. Braden
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