Get PercentRank of a selected range?

[Trader60611]

Hi to the forum...


I only occasionally use VBA so, as usual, I am not coding this correctly. My goal is to select a range, and then output (to a nearby cell on the same row)the percentrank of each cell in the range. The range is a one-column range. so, for example, column 1 contains a list of 5 values. I got the basics of the input box from another macro I did years ago. i don't really remember much about it. Apparently PercentRank doesn't like what I am doing. I have tried a lot of formulations but code will not compile. Here's the macro. Any help, and, if possible, an explanation, would be greatly appreciated:

Sub TestPctRank1()
' TestPctRank1 Macro
' Macro recorded 5/28/2011 by
'Dim Myrange As Range
Dim mycount
Dim Mycounter
Dim MyPercentRank

Set Myrange = Application.InputBox(Prompt:="range:", Type:=8) Set StartCell = Myrange.Cells(1, 1) Set EndCell = Myrange.Cells(Myrange.Rows.Count, 1) mycount = Myrange.Rows.Count Mycounter = 1
ActiveCell.Activate
MyPercentRank = PercentRank(Myrange, Myrange.Cells(Mycounter, 1).Value) ActiveCell.Value = MyPercentRank
Do Until Mycounter = mycount
Mycounter = Mycounter + 1
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = MyPercentRank
Loop
End Sub

[Bob Phillips]

Sub TestPctRank1()

Dim Myrange As Range
Dim Mycounter As Long
Dim MyPercentRank

Set Myrange = Application.InputBox(Prompt:="range:", Type:=8)

For Mycounter = 1 To Myrange.Rows.Count

MyPercentRank = Application.PercentRank(Myrange, Myrange.Cells(Mycounter, 1).Value)
ActiveCell.Offset(Mycounter - 1, 0).Value = MyPercentRank
Next Mycounter
End Sub

[mikerickson]

Here's a non-looping approach
Sub TestPctRank1()
Dim myRange As Range
Dim cellFormula As String
Dim oneCell As Range

Rem user inputs range
On Error Resume Next
Set myRange = Application.InputBox(Prompt:="range:", Default:=Range("C2:C6").Address, Type:=8)
On Error GoTo 0
If myRange Is Nothing Then Exit Sub: Rem canceled


With myRange.Columns(1)
cellFormula = "=PercentRank(" & .Address(True, True, xlR1C1, True) & ", RC[-1])"

On Error Resume Next
With Application.Intersect(.Offset(0, 1), .SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow)
.FormulaR1C1 = cellFormula
.Value = .Value
End With

With Application.Intersect(.Offset(0, 1), .SpecialCells(xlCellTypeFormulas, xlNumbers).EntireRow)
.FormulaR1C1 = cellFormula
.Value = .Value
End With
On Error GoTo 0
End With

End Sub