Sort Macro (Excel 2000)

Topic

New Reply

I have inherited a macro that sorts a standing. The worksheet was from A:O and I inserted a column between H & I.

The macro sorts and puts the ranking #s in Column A starting A8, I made the obvious changes but now when I sort the ranking numbers don’t show up except for the first # in A8 only show “1”.

The sorting is correct beacuse there is a points column where I can see it is correctly sorted, but the sequence #s are not showing.

Here it is….with what changes I made shown in {}.

Sheets(“TempStd”).Select
Columns(“A:P”).Select {was A:O}
Selection.Copy
Sheets(“Standing”).Select
Columns(“A:P”).Select {was A:O}
ActiveSheet.Paste
Range(“B7:O52”).Select {was B7:N52}
Application.CutCopyMode = False
Selection.Sort Key1:=Range(“L8”), Order1:=xlDescending, Key2:=Range(“M8”) _ {L8 was K8 & M8 was L8}
, Order2:=xlAscending, Key3:=Range(“B8”), Order3:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(“A8”).Select
ActiveCell.FormulaR1C1 = “1”
Range(“A9”).Select
ActiveCell.FormulaR1C1 = “=IF(RC[10]<R[-1]C[10],COUNTA(R7C:R[-1]C),99)"
Range("A9").Select
Selection.Copy
Range("A10:A52").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A8:A52").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Replace What:="99", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("A1").Select
End Sub

Help is much appreciated.

Jay.

Reply | Quote

Replies

I tried this with some random numbers and it appeared to work.
Column A started with 1 and had consecutive numbers interspersed with blank cells.

However, if you don’t want column A to be erased you should change the second line to

Columns(“B:Q”).Select

************************
Sheets(“Standing”).Select
Columns(“A:P”).Select {was A:O}
ActiveSheet.Paste

Reply | Quote

I’ve attached a screenshot of what it looks like.

So for column A it only shows ‘1’ in cell A8, it’s supposed to show:

1,2,3,4,5,6,7,7,8,9 (two people with the same points obviously should have the same rank)

The rows end up to Row 52 but can be extended if required.

I changed the 2nd line to (B:Q) but it didn’t work.

Reply | Quote

Change this formula:
ActiveCell.FormulaR1C1 = “=IF(RC[10]<R[-1]C[10],COUNTA(R7C:R[-1]C),99)"

To the following:
ActiveCell.FormulaR1C1 = "=IF(RC[11]<R[-1]C[11],1+R[-1]C,R[-1]C)"

You can then remove the last lines of the code where you do a search/replace on '99'.

Reply | Quote

zymurgy,

I don’t know macros, so pls. specify exactly which group of lines you’re referring to delete.

Tx.

The code now looks like this:

Sheets(“TempStd”).Select
Columns(“B:O”).Select
Selection.Copy
Sheets(“Standing”).Select
Columns(“B:O”).Select
ActiveSheet.Paste
Range(“A7:O52”).Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range(“L8”), Order1:=xlDescending, Key2:=Range(“M8”) _
, Order2:=xlAscending, Key3:=Range(“B8”), Order3:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(“A8”).Select
ActiveCell.FormulaR1C1 = “1”
Range(“A9”).Select
ActiveCell.FormulaR1C1 = “=IF(RC[11]<R[-1]C[11],1+R[-1]C,R[-1]C)"
Range("A9").Select
Selection.Copy
Range("A10:A52").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A8:A52").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Replace What:="99", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("A1").Select
End Sub

Reply | Quote

Jay, now I see your layout, replace all your code with this:

Option Explicit
Sub Temp()
Application.ScreenUpdating = False
Sheets(“TempStd”).Columns(“A:P”).Copy Sheets(“Standing”).Columns(“A:P”)
Application.CutCopyMode = False
Sheets(“Standing”).Activate
ActiveSheet.Range(“A7”).CurrentRegion.Sort Key1:=Range(“L8”), Order1:=xlDescending, _
Key2:=Range(“M8”), Order2:=xlAscending, Key3:=Range(“B8”), Order3:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(“A8”).FormulaR1C1 = “1”
Range(Range(“B9”), Range(“B9”).End(xlDown)).Offset(0, -1).FormulaR1C1 = _
“=IF(RC[10]<R[-1]C[10],COUNTA(R7C:R[-1]C)," & Chr(34) & Chr(34) & ")"
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Test it to be sure it's doing what you want. If there are problems, it's much better to post the WB as an attachment than to post a screen shot, as then Loungers will have real data to work with.

A couple of things:

-Application.Screenupdating = True line will stop all the screen-flashing and speed the running of the code
-you can collapse all those "select" commands into range.action, range.select followed by selection.action is not necessary and slows the code down
–range.copy takes the paste target as an argument if you are not using PasteSpecial, so the copy lines can be improved
– you can apply the formula down an entire range as I have done here without the need to paste it once and copy it.
– my code should be independent of the number of rows
– and my code could probably be better!

Also, I paste the formula as
=IF(K9<K8,COUNTA(A$7:A8),“”),
with no space in the value returned if the conditon is FALSE, rather than
=IF(K9<K8,COUNTA(A$7:A8),” “)
with a space in the FALSE return. Is that OK?

Reply | Quote

Using my formula, you no longer need these lines:

Selection.Replace What:=”99″, Replacement:=” “, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

Reply | Quote

John/Zymurgy

Thanks guys for all your help, I know have it working!

Reply | Quote

[considerably edited][/b]

I have rewritten this, as it could be much shorter. Without knowing what is supposed to be in column K, I’m confused because (as has now been pointed out) the formula created in the code overwrites all column A of the copied data, and the result makes no sense (to me):

Sub Temp()
Sheets(“TempStd”).Columns(“A:P”).Copy Sheets(“Standing”).Columns(“A:P”)
Application.CutCopyMode = False
Sheets(“Standing”).Activate
ActiveSheet.Range(“A8”).CurrentRegion.Select
Selection.Sort Key1:=Range(“L8”), Order1:=xlDescending, Key2:=Range(“M8”), _
Order2:=xlAscending, Key3:=Range(“B8”), Order3:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(“A8”).FormulaR1C1 = “1”
Range(Range(“A9”), Range(“A9”).End(xlDown)).FormulaR1C1 = _
“=IF(RC[10]<R[-1]C[10],COUNTA(R7C:R[-1]C)," & Chr(34) & Chr(34) & ")"
Range("A1").Select
End Sub

Is it supposed to overwrite them? Can you post a sample of the data? Is the formula just supposed to number the rows? Are there only ever 52 rows of data?

Reply | Quote