Dealing with ties in ranking code

[ED]

I currently have vba code that ranks employees based on their average
job time ordered by their region, zone, and job code. I currently
have vba code that will cycle through a query and ranks each employee
based on their region, zone, job code and avg job time. (See code
below). My problem is that I do not know how to rank the ties. Right
now if two people have the same avg time one will be ranked 3rd and
the other ranked 4th. I would like to have them both be ranked 3rd.
If anyone has any ideas please let me know.

Thanks

Public Function CalculateMonthlyTotalsbyYard(strPeriod As String)
'************************************************* ******************************************
' strPeriod has form YYYYMM
'
' To USE this code, you must click 'Tools/References' in the menu bar
' - Then select the "Microsoft DAO 3.6 Object Library" reference.
'************************************************* ******************************************
Dim rstRead As DAO.Recordset
Dim rstWriteEmp As DAO.Recordset
Dim rstWriteTot As DAO.Recordset
Dim strSQL As String
Dim iRank As Integer
Dim iRegionZoneCount As Integer
Dim iPrevZone As Integer
Dim iPrevRegion As Integer
Dim iPrevJobCode As Integer
Dim sPrevYrMo As String

' Set String to hold select statement which returns Employees in
Ranking Order
strSQL = "SELECT * FROM [qryEmployeeSums] " & _
" WHERE [YrMo] = '" & strPeriod & "' " & _
"ORDER BY [Region], [Zone], [JobCode], [AvgTime] ASC;"

' Initialize the Recordset with the query data
Set rstRead = CurrentDb.openrecordset(strSQL)

' Make sure that some rows were returned
If rstRead.RecordCount > 0 Then

' Initialize the Recordset for writing Employee Data
Set rstWriteEmp = CurrentDb.openrecordset("tblEmployeeSums")

' Initialize the Recordset for writing Region,Zone,JobCode
Employee Totals
Set rstWriteTot =
CurrentDb.openrecordset("tblRegionZoneJobTotals")

' Initialize variables
iPrevRegion = 0
iPrevZone = 0
iPrevJobCode = 0

' Move to the first record and
rstRead.MoveFirst

' Spin through each row returned, accumulating rankings
While Not rstRead.EOF
If rstRead![Region] = iPrevRegion And _
rstRead![Zone] = iPrevZone And _
rstRead![JobCode] = iPrevJobCode Then

' Increment Ranking for Current Employee
iRank = iRank + 1

' Increment total counters for Current Region, Zone
and Job Code
iRegionZoneCount = iRegionZoneCount + 1
Else
' Region, Zone or JobCode has changed, write Totals
record
' Note: Do not write for very first record
If iPrevRegion <> 0 Then
With rstWriteTot
.AddNew
![Region] = iPrevRegion
![Zone] = iPrevZone
![JobCode] = iPrevJobCode
![YrMo] = sPrevYrMo
![EmpCount] = iRegionZoneCount
.Update
End With
End If

' Set Previous variables on current record
iPrevRegion = rstRead![Region]
iPrevZone = rstRead![Zone]
iPrevJobCode = rstRead![JobCode]
sPrevYrMo = rstRead![YrMo]
iRank = 1
iRegionZoneCount = 1
End If

' Write Current Employee Total Record to Table
With rstWriteEmp
.AddNew
![Region] = rstRead![Region]
![Zone] = rstRead![Zone]
![JobCode] = rstRead![JobCode]
![YrMo] = rstRead![YrMo]
![EmployeeID] = rstRead![EmployeeID]
![JobsComp] = rstRead![JobsComp]
![TotalTime] = rstRead![TotalTime]
![AvgTime] = rstRead![AvgTime]
![Ranking] = iRank
.Update
End With

' Get the next record
rstRead.MoveNext

Wend

' Write the Final totals record
With rstWriteTot
.AddNew
![Region] = iPrevRegion
![Zone] = iPrevZone
![JobCode] = iPrevJobCode
![YrMo] = sPrevYrMo
![EmpCount] = iRegionZoneCount
.Update
End With

End If

End Function

[PC Datasheet]

Ed,

I haven't studied your code closely so my comments are only general.

You need to first calculate all the avg times. Next you need to run an unique
values query to eliminate duplicate avg times. Next rank the avg times. Finally
associate the ranking to the people. If two people have the same avg time (say
ranked 3rd), both people will be ranked third.

--
PC Datasheet
Your Resource For Help With Access, Excel And Word Applications
re******@pcdatasheet.com
www.pcdatasheet.com
"ED" <da******@hotmail.com> wrote in message
news:ad**************************@posting.google.c om...

I currently have vba code that ranks employees based on their average
job time ordered by their region, zone, and job code. I currently
have vba code that will cycle through a query and ranks each employee
based on their region, zone, job code and avg job time. (See code
below). My problem is that I do not know how to rank the ties. Right
now if two people have the same avg time one will be ranked 3rd and
the other ranked 4th. I would like to have them both be ranked 3rd.
If anyone has any ideas please let me know.

Thanks

Public Function CalculateMonthlyTotalsbyYard(strPeriod As String)
'************************************************* ******************************
************ ' strPeriod has form YYYYMM
'
' To USE this code, you must click 'Tools/References' in the menu bar
' - Then select the "Microsoft DAO 3.6 Object Library" reference.
'************************************************* ******************************
************ Dim rstRead As DAO.Recordset
Dim rstWriteEmp As DAO.Recordset
Dim rstWriteTot As DAO.Recordset
Dim strSQL As String
Dim iRank As Integer
Dim iRegionZoneCount As Integer
Dim iPrevZone As Integer
Dim iPrevRegion As Integer
Dim iPrevJobCode As Integer
Dim sPrevYrMo As String

' Set String to hold select statement which returns Employees in
Ranking Order
strSQL = "SELECT * FROM [qryEmployeeSums] " & _
" WHERE [YrMo] = '" & strPeriod & "' " & _
"ORDER BY [Region], [Zone], [JobCode], [AvgTime] ASC;"

' Initialize the Recordset with the query data
Set rstRead = CurrentDb.openrecordset(strSQL)

' Make sure that some rows were returned
If rstRead.RecordCount > 0 Then

' Initialize the Recordset for writing Employee Data
Set rstWriteEmp = CurrentDb.openrecordset("tblEmployeeSums")

' Initialize the Recordset for writing Region,Zone,JobCode
Employee Totals
Set rstWriteTot =
CurrentDb.openrecordset("tblRegionZoneJobTotals")

' Initialize variables
iPrevRegion = 0
iPrevZone = 0
iPrevJobCode = 0

' Move to the first record and
rstRead.MoveFirst

' Spin through each row returned, accumulating rankings
While Not rstRead.EOF
If rstRead![Region] = iPrevRegion And _
rstRead![Zone] = iPrevZone And _
rstRead![JobCode] = iPrevJobCode Then

' Increment Ranking for Current Employee
iRank = iRank + 1

' Increment total counters for Current Region, Zone
and Job Code
iRegionZoneCount = iRegionZoneCount + 1
Else
' Region, Zone or JobCode has changed, write Totals
record
' Note: Do not write for very first record
If iPrevRegion <> 0 Then
With rstWriteTot
.AddNew
![Region] = iPrevRegion
![Zone] = iPrevZone
![JobCode] = iPrevJobCode
![YrMo] = sPrevYrMo
![EmpCount] = iRegionZoneCount
.Update
End With
End If

' Set Previous variables on current record
iPrevRegion = rstRead![Region]
iPrevZone = rstRead![Zone]
iPrevJobCode = rstRead![JobCode]
sPrevYrMo = rstRead![YrMo]
iRank = 1
iRegionZoneCount = 1
End If

' Write Current Employee Total Record to Table
With rstWriteEmp
.AddNew
![Region] = rstRead![Region]
![Zone] = rstRead![Zone]
![JobCode] = rstRead![JobCode]
![YrMo] = rstRead![YrMo]
![EmployeeID] = rstRead![EmployeeID]
![JobsComp] = rstRead![JobsComp]
![TotalTime] = rstRead![TotalTime]
![AvgTime] = rstRead![AvgTime]
![Ranking] = iRank
.Update
End With

' Get the next record
rstRead.MoveNext

Wend

' Write the Final totals record
With rstWriteTot
.AddNew
![Region] = iPrevRegion
![Zone] = iPrevZone
![JobCode] = iPrevJobCode
![YrMo] = sPrevYrMo
![EmpCount] = iRegionZoneCount
.Update
End With

End If

End Function

[Michael Monk]

This may not be the most efficient way but I think this will work
** Designates new lines of code

**Dim iPrevAvgTime As Integer
**Dim iTempAvgTime As Integer

**'initialize
**iPrevAvgTime = 0

' Spin through each row returned, accumulating rankings
While Not rstRead.EOF
If rstRead![Region] = iPrevRegion And _
rstRead![Zone] = iPrevZone And _
rstRead![JobCode] = iPrevJobCode Then
** rstRead![AvgTime] = iTempAvgTime

** If iTempAvgTime = iPrevAvgTime And iRank <> 0 Then
** iRank = iRank - 1
** End If

** iPrevAvgTime = iTempAvgTime
' Increment Ranking for Current Employee
iRank = iRank + 1

[John Winterbottom]

"ED" <da******@hotmail.com> wrote in message
news:ad**************************@posting.google.c om...

I currently have vba code that ranks employees based on their average
job time ordered by their region, zone, and job code. I currently
have vba code that will cycle through a query and ranks each employee
based on their region, zone, job code and avg job time. (See code
below). My problem is that I do not know how to rank the ties. Right
now if two people have the same avg time one will be ranked 3rd and
the other ranked 4th. I would like to have them both be ranked 3rd.
If anyone has any ideas please let me know.

I'm sure you would be better off replacing all this code with a single SQL
query. If you post your (simplified) table struture with some sample data
and the output you need someone will probably be able to write the query for
you.

[ED D]

Thanks for the help everyone, I was able to account for the ties with
the following code.
Dim rstRead As DAO.Recordset
Dim rstWriteEmp As DAO.Recordset
Dim rstWriteTot As DAO.Recordset
Dim strSQL As String
Dim iRank As Integer
Dim iRegionZoneCount As Integer
Dim iPrevZone As Integer
Dim iPrevRegion As String
Dim iPrevJobCode As String
Dim sPrevYr As String

Dim iPrevAvgTime As Integer
Dim iRankSkipCounter As Integer
Dim iLastRecordTie As Integer
Dim iCurrAvgTime As Integer

' Set String to hold select statement which returns Employees in
Ranking Order
strSQL = "SELECT * FROM [qryEmployeeSumsbyYard] " & _
" WHERE [Year] = '" & strPeriod & "' " & _
"ORDER BY [Region Code], [Zone Code], [Job Code], [AvgTime]
ASC;"

' Initialize the Recordset with the query data
Set rstRead = CurrentDb.openrecordset(strSQL)

' Make sure that some rows were returned
If rstRead.RecordCount > 0 Then

' Initialize the Recordset for writing Employee Data
Set rstWriteEmp =
CurrentDb.openrecordset("tblEmployeeSumsbyYard")

' Initialize the Recordset for writing Region,Zone,JobCode
Employee Totals
Set rstWriteTot =
CurrentDb.openrecordset("tblRegionZoneJobTotals")

' Initialize variables
iPrevRegion = "0"
iPrevZone = 0
iPrevJobCode = "0"

' Move to the first record and
rstRead.MoveFirst

' Spin through each row returned, accumulating rankings
While Not rstRead.EOF

If rstRead![Region Code] = iPrevRegion And _
rstRead![Zone Code] = iPrevZone And _
rstRead![Job Code] = iPrevJobCode Then

' Check if Current Employee's time equals the Previous
Employee's time.
If iPrevAvgTime = rstRead![AvgTime] Then
'If Current Employee's time is equal to the Previous
Employee's time then advance
'counter by 1 and set Record Tie Flag to 1
iRankSkipCounter = iRankSkipCounter + 1
iLastRecordTie = 1

Else

' If there is no tie, Increment Ranking for Current
Employee
iRank = iRank + 1

'If there is no tie, then test to see if the Record Tie
Flag is = 1
If iLastRecordTie = 1 Then

'If there is a tie set the current employee's
ranking to the previous rank + SkipCounter
iRank = iRank + iRankSkipCounter
iRankSkipCounter = 0
iLastRecordTie = 0

End If

End If

' Increment total counters for Current Region, Zone/Yard
and Job Code
iRegionZoneCount = iRegionZoneCount + 1
Else
' Region, Zone or JobCode has changed, write Totals
record
' Note: Do not write for very first record
If iPrevRegion <> 0 Then
With rstWriteTot
.AddNew
![Region Code] = iPrevRegion
![Zone Code] = iPrevZone
![Job Code] = iPrevJobCode
![Year] = sPrevYr
![EmpCount] = iRegionZoneCount
.Update
End With
End If

' Set Previous variables on current record
iPrevRegion = rstRead![Region Code]
iPrevZone = rstRead![Zone Code]
iPrevJobCode = rstRead![Job Code]
sPrevYr = rstRead![Year]
iRank = 1
iRegionZoneCount = 1
'Initialize tie variables back to 0
iRankSkipCounter = 0
iLastRecordTie = 0

End If

' Write Current Employee Total Record to Table
With rstWriteEmp
.AddNew
![Region Code] = rstRead![Region Code]
![Zone Code] = rstRead![Zone Code]
![Job Code] = rstRead![Job Code]
![Year] = rstRead![Year]
![Employee ID] = rstRead![Employee ID]
![JobsComp] = rstRead![JobsComp]
![TotalTime] = rstRead![TotalTime]
![AvgTime] = rstRead![AvgTime]
![Ranking] = iRank
.Update
End With

'Set the iPrevAvgTime to the current record AvgTime before
you get the next record
iPrevAvgTime = rstRead![AvgTime]
'Get the next record of the recordset
rstRead.MoveNext

Wend

' Write the Final totals record
With rstWriteTot
.AddNew
![Region Code] = iPrevRegion
![Zone Code] = iPrevZone
![Job Code] = iPrevJobCode
![Year] = sPrevYr
![EmpCount] = iRegionZoneCount
.Update
End With

End If

End Function

Thanks Again
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

[clintonG]

The Microsoft Partners Directory FAQ [1] explains how Microsoft
prioritized a ranking system for partner listings.

--
<%= Clinton Gallagher, "Twice the Results -- Half the Cost"
Architectural & e-Business Consulting -- Software Development
NET cs*********@REMOVETHISTEXTmetromilwaukee.com
URL http://www.metromilwaukee.com/clintongallagher/

[1] http://members.microsoft.com/partner...aspx#P137_9139

"ED" <da******@hotmail.com> wrote in message
news:ad**************************@posting.google.c om...

I currently have vba code that ranks employees based on their average
job time ordered by their region, zone, and job code. I currently
have vba code that will cycle through a query and ranks each employee
based on their region, zone, job code and avg job time. (See code
below). My problem is that I do not know how to rank the ties. Right
now if two people have the same avg time one will be ranked 3rd and
the other ranked 4th. I would like to have them both be ranked 3rd.
If anyone has any ideas please let me know.

Thanks

Public Function CalculateMonthlyTotalsbyYard(strPeriod As String)
'************************************************* **************************
**************** ' strPeriod has form YYYYMM
'
' To USE this code, you must click 'Tools/References' in the menu bar
' - Then select the "Microsoft DAO 3.6 Object Library" reference.
'************************************************* **************************
**************** Dim rstRead As DAO.Recordset
Dim rstWriteEmp As DAO.Recordset
Dim rstWriteTot As DAO.Recordset
Dim strSQL As String
Dim iRank As Integer
Dim iRegionZoneCount As Integer
Dim iPrevZone As Integer
Dim iPrevRegion As Integer
Dim iPrevJobCode As Integer
Dim sPrevYrMo As String

' Set String to hold select statement which returns Employees in
Ranking Order
strSQL = "SELECT * FROM [qryEmployeeSums] " & _
" WHERE [YrMo] = '" & strPeriod & "' " & _
"ORDER BY [Region], [Zone], [JobCode], [AvgTime] ASC;"

' Initialize the Recordset with the query data
Set rstRead = CurrentDb.openrecordset(strSQL)

' Make sure that some rows were returned
If rstRead.RecordCount > 0 Then

' Initialize the Recordset for writing Employee Data
Set rstWriteEmp = CurrentDb.openrecordset("tblEmployeeSums")

' Initialize the Recordset for writing Region,Zone,JobCode
Employee Totals
Set rstWriteTot =
CurrentDb.openrecordset("tblRegionZoneJobTotals")

' Initialize variables
iPrevRegion = 0
iPrevZone = 0
iPrevJobCode = 0

' Move to the first record and
rstRead.MoveFirst

' Spin through each row returned, accumulating rankings
While Not rstRead.EOF
If rstRead![Region] = iPrevRegion And _
rstRead![Zone] = iPrevZone And _
rstRead![JobCode] = iPrevJobCode Then

' Increment Ranking for Current Employee
iRank = iRank + 1

' Increment total counters for Current Region, Zone
and Job Code
iRegionZoneCount = iRegionZoneCount + 1
Else
' Region, Zone or JobCode has changed, write Totals
record
' Note: Do not write for very first record
If iPrevRegion <> 0 Then
With rstWriteTot
.AddNew
![Region] = iPrevRegion
![Zone] = iPrevZone
![JobCode] = iPrevJobCode
![YrMo] = sPrevYrMo
![EmpCount] = iRegionZoneCount
.Update
End With
End If

' Set Previous variables on current record
iPrevRegion = rstRead![Region]
iPrevZone = rstRead![Zone]
iPrevJobCode = rstRead![JobCode]
sPrevYrMo = rstRead![YrMo]
iRank = 1
iRegionZoneCount = 1
End If

' Write Current Employee Total Record to Table
With rstWriteEmp
.AddNew
![Region] = rstRead![Region]
![Zone] = rstRead![Zone]
![JobCode] = rstRead![JobCode]
![YrMo] = rstRead![YrMo]
![EmployeeID] = rstRead![EmployeeID]
![JobsComp] = rstRead![JobsComp]
![TotalTime] = rstRead![TotalTime]
![AvgTime] = rstRead![AvgTime]
![Ranking] = iRank
.Update
End With

' Get the next record
rstRead.MoveNext

Wend

' Write the Final totals record
With rstWriteTot
.AddNew
![Region] = iPrevRegion
![Zone] = iPrevZone
![JobCode] = iPrevJobCode
![YrMo] = sPrevYrMo
![EmpCount] = iRegionZoneCount
.Update
End With

End If

End Function