Sorting and scoring 2

[Manowar]

I would like to create a sorting and scoring sheme in Access across a number of fields in one table. If necessary, generating another table from the query.

Table has a number of categories for employees. Each category has a number associated with it.

I want Access to sort then score each category for each person IE:

NAME CALLS SPEED TIME
Joe 100 54 20
Mary 50 17 13
Jane 75 33 15

Would be
CALL SPEED TIME
NAME CALLS SCORE SPEED SCORE TIME SCORE TOTAL
Joe 100 3 54 1 20 1 5
Mary 50 1 17 3 13 3 7
Jane 75 2 33 2 15 2 6

Best Mary 7
Jane 6
Joe 5

 

[ntp]

Create a query based on the table. Add four expression fields which will return the score for Calls, Speed, Time and Total and then return the TOP 3. There is a reserved word you can use to return the top n records based on the order by specification.

ntp

 

[Manowar]

OK ... But that's what I need help with ... How do I write an expression to rank each column?

 

[ntp]

What criteria are you using? let's say you are using the category the person belongs to. Write a function like this:

Public Function score(intValue as Integer) as Integer
Select case (intValue)
case 1: score = 3
case 2: score = 4
End Select
End Function

Then in your query you will have a field:

field: CallScore: Score(tblCategory.CatID)
etc
field: TotalScore: CallScore + SpeedScore + TimeScore

Give me a better idea on what type of criteria you are looking for and I'll be able to explain more to the point

ntp

 

[Manowar]

Right now this is all done manually ... I see no reason Access can't do it though.

I have a group of 16 CSR's that have 6 categories they need to be ranked on. 16 is the best and 1 is the worst. Ties are possible but not likely.

Each category has it's own range that is different from all the others.

The score on some should be better for higher numbers.
The score on some should be better for lower numbers.

Once a score for each category is 'created' these individual scores will need to be SUM together, but that is easy.

If it is easier, just e-mail me.

 

[ntp]

Manowar,
Send me a copy of the database with the table structures, and How you what calculations you need performed. I'll be able to better help you like that.

ntp
nparray@plipdeco.com

 

[PaulF]

It might be easier to create a new table to store the data in. This example uses two tables, the only difference between the two is additional fields to store the Scores.
tblSortingAndScoring (original Data)
tblTempSortingAndScoring (Table With Results)

I use a function which first deletes any existing data, append the latest data and then loops through the data sorted by each of the possible fields which can be scored, and then once more to total the scores and compute the score based on the AbsolutePosition of the recordset (since it is zero based, I add one to get the correct value for the score). Since your example showed Calls, Speed and Time, this example deals with only those.


Public Function ReturnScore()
DoCmd.SetWarnings False
DoCmd.RunSQL ("Delete * From tblTempSortingAndScoring;&quot
DoCmd.RunSQL ("INSERT INTO tblTempSortingAndScoring SELECT" _
& " tblSortingAndScoring.* FROM tblSortingAndScoring;&quot
DoCmd.SetWarnings True
Dim db As DAO.DATABASE, rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By Calls;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!CallsScore = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By Calls;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!CallsScore = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By Speed Desc;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!SpeedScore = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By Time;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!TimeScore = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!TotalScore = rst!CallsScore + rst!SpeedScore + rst!TimeScore
.Update
.MoveNext
Loop
End With
End Function


HTH

PaulF

 

[Manowar]

OK ... Couple of questions Paul

Where does this code go? Modules?

 

[PaulF]

well this example is for a function that would be in a module, but you can attach it to the Click Event of a command button if you want to, just remove Public Function ReturnScore() and End Function, cut and paste into your form, and change the table names and field names to the correct values. Also add additional "Select * From" code to capture any other scores, and add that value to the last part of the code where the TotalScore Field is updated.

PaulF

 

[Manowar]

Is there a way to make some of the scores reversed? IE: 200 in Time is a lower score than a 100 in Time but 200 in Calls is higher than 100 in Calls.

 

[PaulF]

the way you set your Order By statement in the OpenRecordset determines how the results will be scored.

use Desc for descending order, leave blank for ascending order

Order By Calls 'for ascending
Order By Calls Desc 'for descending

PaulF

 

[Manowar]

OK ... Most of it is working ... Two minor issues

1. Ties ... There can be ties in one of the categories that should be averaged together for a result IE: Three people get 10 calls and thus should be scored the AVERAGE of their 3 combined scores.

2. The original numbers are not coming over in their correct format ... The decimal places are being dropped or rounded ... It also looks like rounding is taking place on the one %-age column I have

Ideas?

 

[PaulF]

As far as ties go, you probably need to add additional coding to test for the value
Add new variables

Dim intValue as Integer, intLastCount as Integer

With rst
.MoveFirst
intValue = rst!Calls
intLastCount = 1
Do While Not .EOF
If rst.AbsolutePosition + 1 = 1 then
.Edit
rst!CallsScore = 1
.Update
Else
.Edit
If rst!Calls = intValue then
rst!CallsScore = intLastCount
Else
rst!CallsScore = rst.AbsolutePosition + 1
intValue = rst!Calls
intLastCount = rst.AbsolutePosition + 1
End If
.update
End If
.MoveNext
Loop
End With

As far as dropping the decimals, or rounding, you need to use a data type other than Integer or Long Integer. I've read where using Currency format eliminates some rounding problems, but don't know whether it will work in your situation.

PaulF

 

[Manowar]

And this code replaces the code for that particular scoring entry or it appends it

 

[PaulF]

replaces, need to replace for all of the code where it determines the score.

PaulF

 

[Manowar]

Getting an error in that area now

Compile Error:

User-Defined type not defined

It then points to this line in yellow

Public Function ReturnScore()

and this portion is highlighted as well

new variables of the Add new variables line

 

[PaulF]

"add new variables" was just a comment to tell you that you needed to Dim two new variables for this change to work, it was not part of the code, also if you attached the code to a command button, then Public Function ReturnScore() is not suppose to be in there, neither is End Function. So, you should remove the "Add new variables" from your code. Then you need to replace the 3 sections (dealing with rst!CallsScore= , rst!SpeedScore= , And rst!TimeScore= )of the first code I sent you (From With rst to End With) with this lastest part of the code, remembering to change the code each time you paste it over the existing code.
.
rst!CallsScore= rst.AbsolutePosition + 1 or rst!CallsScore= intLastCount
to
rst!SpeedScore= rst.AbsolutePosition + 1 or rst!SpeedScore= intLastCount
to
rst!TimeScore= rst.AbsolutePosition + 1 or rst!TimeScore = intLastCount

in the appropriate sections

PaulF

 

[Manowar]

OK ... First off, thanks for all your help ... I am MUCH farther on this now than I thought I would be @ this time

Changing the type to DOUBLE solved the rounding issue

The parts that may TIE are RONA, ACDCalls and PercentAvail
Score categories for each are SCORERONA, SCOREACDCalls, SCOREPercentAvail

Here is what I have now


Public Function ReturnScore()
DoCmd.SetWarnings False
DoCmd.RunSQL ("Delete * From tblTempSortingAndScoring;&quot
DoCmd.RunSQL ("INSERT INTO tblTempSortingAndScoring SELECT" _
& " tblSortingAndScoring.* FROM tblSortingAndScoring;&quot
DoCmd.SetWarnings True
Dim db As DAO.Database, rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By ACDCalls;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!SCOREACDCalls = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By RONA Desc;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!SCORERONA = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By AvgACDTimeMin Desc;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!SCOREAvgACDTimeMin = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By AvgACWTimeSec Desc;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!SCOREAvgACWTimeSec = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By PercentAvail;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!SCOREPercentAvail = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By ACDCallsPerAvailHour;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!SCOREACDCallsPerAvailHour = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring;&quot
With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!TOTALSCORE = rst!SCOREACDCallsPerAvailHour + rst!SCOREPercentAvail + rst!SCOREAvgACWTimeSec + rst!SCOREAvgACDTimeMin + rst!SCORERONA + rst!SCOREACDCalls
.Update
.MoveNext
Loop
End With
End Function

 

[PaulF]

Add the code to Dim the variables after the Dim db As DAO.Database line

Dim intValue as Integer, intLastCount as Integer

You may need to Dim intValue as Variant to cover both integer and double data types

change the following part of the code that deals with ACDCalls

With rst
.MoveFirst
Do While Not .EOF
.Edit
rst!SCOREACDCalls = rst.AbsolutePosition + 1
.Update
.MoveNext
Loop
End With

To

With rst
.MoveFirst
intValue = rst!ACDCalls
intLastCount = 1
Do While Not .EOF
If rst!ACDCalls = intValue then
rst!SCOREACDCalls = intLastCount
Else
rst!SCOREACDCalls = rst.AbsolutePosition + 1
intValue = rst!ACDCalls
intLastCount = rst.AbsolutePosition + 1
End If
.update
End If
.MoveNext
Loop
End With

Repeat the replacement of the code for RONA and PercentAvail, remembering to
change the rst! data where necessary.

BTW I'm done for the day, if you have any more questions, they'll have to wait until tomorrow.
PaulF

 

[Manowar]

Hmm ... No it just 'dings' when I try to run it ... I have tried it with both VARIANT and INTEGER in the dim area

CODE BELOWRepeated for RONA and PercentAvail

Public Function ReturnScore()
DoCmd.SetWarnings False
DoCmd.RunSQL ("Delete * From tblTempSortingAndScoring;&quot
DoCmd.RunSQL ("INSERT INTO tblTempSortingAndScoring SELECT" _
& " tblSortingAndScoring.* FROM tblSortingAndScoring;&quot
DoCmd.SetWarnings True
Dim db As DAO.Database, rst As DAO.Recordset
Dim intValue As Variant, intLastCount As Integer
Set db = CurrentDb
Set rst = db.OpenRecordset("Select * From tblTempSortingAndScoring Order By ACDCalls;&quot
With rst
.MoveFirst
intValue = rst!ACDCalls
intLastCount = 1
Do While Not .EOF
If rst!ACDCalls = intValue Then
rst!SCOREACDCalls = intLastCount
Else
rst!SCOREACDCalls = rst.AbsolutePosition + 1
intValue = rst!ACDCalls
intLastCount = rst.AbsolutePosition + 1
End If
.Update
End If
.MoveNext
Loop
End With