rank in VBA

[G2K]

Hi,

i need to calculate rank of employee on the basis of their monthly performance. i have data in columm D. i want a macro to sort this data in accending order, add one column E(Rank) and calculate the rank accordingly.

i have tried to record a macro to do this but unfortunately this is not working out.

also i want to protect this sheet by VBA.

Please help................

 

[ravishankar]

Hi
try these codes

Sub G2000()
Dim x As Long, a As Long
x = Cells(Rows.Count, 4).End(xlUp).Row
ActiveSheet.Unprotect
For a = 1 To 5
Cells(a, 5) = "=Large(D2:D" & x & "," & a & ")"
Next a
 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
 MsgBox "complete"
End Sub

It lists Top 5 values from D in col E and protects the sheet
ravi

 

[G2K]

Thanks Ravi,

i have made some changes in this code as i want to calculate rank,however it is still not working and generates Error- #NAME? in respective cells.

below is the code -

Sub G2000()
Dim x As Long, a As Long
x = Cells(Rows.Count, 4).End(xlUp).Row
ActiveSheet.Unprotect
For a = 1 To 5
Cells(a, 5) = "=Application.WorksheetFunction.Rank(D" & a & ",$D$1:D" & x & "," & a & ")"
Next a
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
MsgBox "complete"
End Sub

Thanks
Gautam

 

[ravishankar]

HI
Col D shold be sorted in ascending order before using this macro.

Sub G2000()
Dim a As Long
ActiveSheet.Unprotect
    For a = 1 To 5
    Cells(a, 5) = Application.WorksheetFunction.Rank(Cells(a, 4), Range("D1:D" & Range("D65536").End(xlUp).Row), 1)
    Next a
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
MsgBox "complete"
End Sub

Ravi

 

[G2K]

thanks alot for your kind help.

it's working fine, but it is not able to handle the error. when ever it finds balnk cell. it genereates error -"Unable to uset the rank property of the worksheet function calss".

i have edited the code as follows but no luck

For a = 2 To Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row


If Not IsError(Application.WorksheetFunction.Rank(Cells(a, 24), Range("x:x"))) Then

Cells(a, 9).Value = Application.WorksheetFunction.Rank(Cells(a, 24), Range("x:x"))

Else

Cells(a, 9).Value = "NA"

End If

Next

i want cell value as "NA" where ever the blank cell in corosponding array.

thanks in advance.