cells in ascending order

[mikewild2000]

i have 2 colums of cells K10 to K20 AND L10 to L20.

The K column holds team numbers (1 to 10)
The L column holds each teams accumlated score.

I am trying to sort the scores in to ascending order, yet keep the tea
numbers with the correct score.

For example

1 16
2 45
3 21
4 23
5 12, etc, etc before it is sorted in ascending dorder.

what i am trying to acheve is this:

2 45
4 23
3 21
1 16
5 12

I do hope somebody can help

 

[Bob Phillips]

Select both columns of data, and sort with the 2nd as the key.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[pikus]

Set ws1 = Worksheets(1)
For x = 10 To 20
Score = ws1.Cells(x, 12).Value
scoreRow = x
For y = x + 1 To 20
If ws1.Cells(y, 12).Value > Score Then
Score = ws1.Cells(y, 12).Value
scoreRow = y
End If
Next y
If scoreRow <> x Then
ws1.Cells(scoreRow, 11).Cut
ws1.Cells(x, 11).Insert
ws1.Cells(scoreRow, 12).Cut
ws1.Cells(x, 12).Insert
End If
Next x

Hope you like. - Piku

 

[mikewild2000]

Pikus

Does this code go into ThisWorkbook or Sheet1
also under what category? Worksheet_selectionchange?

Sorry Bob your idea did not wor

 

[pikus]

You can put it in any number of places depending on when exactly yo
want it to run. It's small enough that it wouldn't disrupt things to
much if you put in ThisWorkbook in the SheetChange event so it run
after any change at all is made, but it would be more efficient if yo
did something like this:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target A
Range)
If Target.Column >= 11 And _
Target.Column <= 12 And _
Target.Row >= 10 And _
Target.Row <= 20 Then
Set ws1 = Worksheets(1)
For x = 10 To 20
score = ws1.Cells(x, 12).Value
scoreRow = x
For y = x + 1 To 20
If ws1.Cells(y, 12).Value > score Then
score = ws1.Cells(y, 12).Value
scoreRow = y
End If
Next y
If scoreRow <> x Then
ws1.Cells(scoreRow, 11).Cut
ws1.Cells(x, 11).Insert
ws1.Cells(scoreRow, 12).Cut
ws1.Cells(x, 12).Insert
End If
End If
End Sub

Let me know how that works. - Piku

 

[mikewild2000]

complie error

end if without block if

 

[pikus]

Sorry! How sloppy of me!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target A
Range)
If Target.Column >= 11 And _
Target.Column <= 12 And _
Target.Row >= 10 And _
Target.Row <= 20 Then
Set ws1 = Worksheets(1)
For x = 10 To 20
score = ws1.Cells(x, 12).Value
scoreRow = x
For y = x + 1 To 20
If ws1.Cells(y, 12).Value > score Then
score = ws1.Cells(y, 12).Value
scoreRow = y
End If
Next y
Next x
If scoreRow <> x Then
ws1.Cells(scoreRow, 11).Cut
ws1.Cells(x, 11).Insert
ws1.Cells(scoreRow, 12).Cut
ws1.Cells(x, 12).Insert
End If
End If
End Sub

:

 

[pikus]

Sorry again! I forgot about the endless looping and I put Next x in th
wrong place. I'm so embarrassed...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target A
Range)
If Target.Column >= 11 And _
Target.Column <= 12 And _
Target.Row >= 10 And _
Target.Row <= 20 Then
Set ws1 = Worksheets(1)
For x = 10 To 20
score = ws1.Cells(x, 12).Value
scoreRow = x
For y = x + 1 To 20
If ws1.Cells(y, 12).Value > score Then
score = ws1.Cells(y, 12).Value
scoreRow = y
End If
Next y
If scoreRow <> x And ws1.Cells(scoreRow, 12).Value <> score Then
ws1.Cells(scoreRow, 11).Cut
ws1.Cells(x, 11).Insert
ws1.Cells(scoreRow, 12).Cut
ws1.Cells(x, 12).Insert
End If
Next x
End If
End Su

 

[mikewild2000]

with the first line in place it does not work. Omit the first line the
the code keeps on looping, and i have to crash excel to stop it

 

[pikus]

See above Mike. It's 6:40 Friday afternoon and that's the best excuse I
can give...

 

[mikewild2000]

It still does not work.

The first one worked, but i had to keep clicking inside the cells.

 

[pikus]

WORK THIS TIME DARNIT!!!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target A
Range)
Application.EnableEvents = False
If Target.Column >= 11 And _
Target.Column <= 12 And _
Target.Row >= 10 And _
Target.Row <= 20 Then
Set ws1 = Worksheets(1)
For x = 10 To 20
score = ws1.Cells(x, 12).Value
scoreRow = x
For y = x + 1 To 20
If ws1.Cells(y, 12).Value > score Then
score = ws1.Cells(y, 12).Value
scoreRow = y
End If
Next y
If scoreRow <> x Then
ws1.Cells(scoreRow, 11).Cut
ws1.Cells(x, 11).Insert
ws1.Cells(scoreRow, 12).Cut
ws1.Cells(x, 12).Insert
End If
Next x
End If
Application.EnableEvents = True
End Su

 

[mikewild2000]

The target colums bit is wrong and if i rem it out also with the enabl
events it works.

Put the enable events back in, it does not work

 

[pikus]

Check your private messages yo. - Piku

 

[Tom Ogilvy]

Writing code to do what Excel already does a 1000 times faster is pretty
much less than the best use of time. This code uses Excel's built in
capability to sort.

Sub SortData()
Range("K10:L20").Sort Key1:=Range("L10"), _
Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End Sub

if you want it in the change event (this won't loop endlessly)

Right click on the sheet tab and select view code, paste in this code

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, _
Range("L10:L20")) Is Nothing Then
On Error GoTo ErrHandler
Application.EnableEvents = False
Range("K10:L20").Sort Key1:=Range("L10"), _
Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
ErrHandler:
Application.EnableEvents = True
End Sub

Although this might make updating your scores a little more complex as they
constantly resort.

 

[mikewild2000]

i think the problem lies in that cells L10 to L19 take their data fro
other cells.
eg
L10's code is "=B5"
L11's code is "=D5

 

[mikewild2000]

i think the problem lies in that cells L10 to L19 take their data fro
other cells.
eg
L10's code is "=B5"
L11's code is "=D5

 

[Tom Ogilvy]

Change your formulas to absolue references
=$B$5 for L10 for example

and it should work as you would expect.

You can then move the code to the calculate event rather than the change
event.

Works fine for me.

Private Sub Worksheet_Calculate()
On Error GoTo ErrHandler
Application.EnableEvents = False
Range("K10:L20").Sort Key1:=Range("L10"), _
Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

ErrHandler:
Application.EnableEvents = True
End Sub

 

[Bob Phillips]

Which is what I suggested without code originally, but apparently it didn't
work (sic!).

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Writing code to do what Excel already does a 1000 times faster is pretty
much less than the best use of time. This code uses Excel's built in
capability to sort.

Sub SortData()
Range("K10:L20").Sort Key1:=Range("L10"), _
Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End Sub

if you want it in the change event (this won't loop endlessly)

Right click on the sheet tab and select view code, paste in this code

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, _
Range("L10:L20")) Is Nothing Then
On Error GoTo ErrHandler
Application.EnableEvents = False
Range("K10:L20").Sort Key1:=Range("L10"), _
Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
ErrHandler:
Application.EnableEvents = True
End Sub

Although this might make updating your scores a little more complex as they
constantly resort.

 

[mikewild2000]

I have got it to work now. A case of juggling the code about a little.
Thanks everybody. It has been a good ride!!!