Ranking In Access

S

SoCal Rick

I have a client who ranks the results of their employees at month end for
three measures (M1: 1-n, M2: 1-n, M3: 1-n), then ranks the combined ranks to
determine the overall ranking (M1: Rank + M2: Rank + M3 Rank = Overall Rank)
and awards the top percentage.
I tried a number of ways of doing this in Access (easy in Excel) and finally
hit upon the following method. If anyone finds this useful, you're welcome
to use it and if anyone can enhance it, I look forward to hearing about it.

Using VBA I created a "Ranking" table with an autonumber field, the control
field and the measure field. I used a query to sort the data by the measure
and appended the results to the new table. I copied the new table (with the
autonumber) to a second table. Then I deleted the "Ranking" table.
I repeated this process for the next two elements, updating additional
fields in the second table (Control Field, Measure-1, Rank-1, Measure-2,
Rank-2, Measure-3, Rank-3). Ran a query adding together the three ranks,
sorted on the rank, created the "Ranking" table and appended the query to the
"Ranking" table.

Since most of this is accomplished with normal queries, I've included the
VBA code I used since it is the only special information required.

The following code deletes and creates the "Ranking" table.
=======================================
Private Sub DeleteAddTable()
Dim dbs As Database
Dim tdf As DAO.TableDef
Dim fldANbr As DAO.Field
Dim fldFactor As DAO.Field
Dim fldRank As DAO.Field

Set dbs = CurrentDb
On Error Resume Next

'if the table already exists, delete it
If IsObject(dbs.TableDefs("tbl Rank")) Then
dbs.TableDefs.Delete "tbl Rank"
End If
On Error GoTo 0

'Create the table definition in memory
Set tdf = dbs.CreateTableDef("tbl Rank")

'Create the field definitions in memory
Set fldANbr = tdf.CreateField("A_Number", dbText, 15)
fldANbr.AllowZeroLength = False
fldANbr.Required = True

Set fldFactor = tdf.CreateField("Factor", dbDouble, 12)
Set fldRank = tdf.CreateField("Rank", dbLong, 10)
fldRank.Attributes = dbAutoIncrField
fldRank.Required = True

'Append the fields to the TableDef's Fields collection
tdf.Fields.Append fldANbr
tdf.Fields.Append fldFactor
tdf.Fields.Append fldRank


'Append the TableDef to the Database's TableDefs collection
dbs.TableDefs.Append tdf

'Refresh the TableDefs collection
dbs.TableDefs.Refresh

'Clean up
Set fldANbr = Nothing
Set fldFactor = Nothing
Set fldRank = Nothing
Set tdf = Nothing
Set dbs = Nothing

End Sub
==================================

I look forward to hearing from other users.
Rick
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top