VBA for Ranking

CanadianAccessUser

Registered User.
Local time
Today, 13:24
Joined
Feb 7, 2014
Messages
114
VBA for Ranking - Help adjusting code PLEASE

Hello,

I have a query I need help with.
My query has a variety of statistics for each employee.
There is a field in my query called KPIMiss which takes each KPI(Statistic) and gives them a percentage that it's worth, then subracts that percentage from the total of 100% giving each employee a final grade.
That all works great.
The problem lies with trying to rank each employee on the KPIMiss percentage.

I found the following code online and tried to use it, but I keep getting errors saying that there are 4 parameters required even tho I've filled in all the requirements. Any ideas?

Code:
Function Rank(vNumber As Variant, sTableName As String, sFieldName As String, Optional bAscending As Boolean = True, Optional sWhereCondition As String) As Variant
    'Version    1.4
    'Created    12/07/2010 22:10    Apollo67
    'Purpose    Emulates MS Excel's Rank() function, for use in queries
    '
    'Description:
    'Returns the rank of a number in a list of numbers. The rank of a number is its size relative to other values in a list.
    '(If you were to sort the list, the rank of the number would be its position.)
 
    'Inputs:
    'dNumber = The number whose rank you want find
    'sTableName = The current table name
    'sFieldName = The field of numbers to be evaluated
    'bAsceding = Optional ranking order - True for Asceding Else False
    'sWhereCondition = an optional criteria constraint to query records on
 
    On Error GoTo Err_Rank
 
    Dim rs As DAO.Recordset
    Dim db As Database
    Dim sSQL As String
    Dim sWhere As String
    Dim sOrderBy As String
    Dim vReturn As Variant
    Dim lRow As Long
    Dim dLastValue As Double
    Dim dCurrValue As Double
    Dim dNumber As Double
 
    vReturn = Null
 
    If (Not IsNull(vNumber)) Then
        dNumber = CDbl(vNumber)
 
        sSQL = "SELECT " & sFieldName & " FROM " & sTableName
        sOrderBy = " ORDER BY " & sFieldName & IIf(bAscending, "", " DESC")
        If (Len(sWhereCondition) > 0) Then sSQL = sSQL & " WHERE " & sWhereCondition
        sSQL = sSQL & sOrderBy
 
        Set db = CurrentDb
        Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
 
        If (rs.RecordCount > 0) Then
            lRow = 0
            Do While Not rs.EOF
                dCurrValue = CDbl(Nz(rs.Fields(0), 0))
                If (dLastValue <> dCurrValue) Then lRow = lRow + 1
                If (dNumber = dCurrValue) Then
                    vReturn = lRow
                    Exit Do
                End If
                dLastValue = dCurrValue
                rs.MoveNext
            Loop
        End If
        rs.Close
    End If
 
Exit_Rank:
    Set rs = Nothing
    Set db = Nothing
    Rank = vReturn
    Exit Function
 
Err_Rank:
    'Optionaly handle error as necessary
    'Generic Error Handler
    MsgBox "Error: " & Err.Number & vbCr & vbCr & Err.Description, , "Error In Procedure Rank()"
    Resume Exit_Rank
 
End Function

My deadline is end of day today... :banghead:
 
Last edited:
All you really need is a DCount (http://www.techonthenet.com/access/functions/domain/dcount.php). The key is getting the criteria correct---you only want to count records who have a lower ranking. If 5 records have lower rankings, then the one you are working with is #6.

If you need more specific help, post the name of your query and the relevant fields along with some sample data.
 
Put MsgBox " >>> " & sSQL just above Set db = CurrentDb and paste the message box content here please.
 
I just spoke with my boss and apparently he needed the ranking in order to do a calculation that I've already mastered without having to rank. Therefore, Rank is no longer required.

Just that efficient... ;) haha

Thanks guys
 

Users who are viewing this thread

Back
Top Bottom