David,
Here you go. Busy today, so had to wait for afternoon break.
1) The linked fields on the report are named TYPE_A, TYPE_B, TYPE_C, TYPE_D. They are pushed off to the side somewhere, and are marked "not visible".
2) There are 4 other fields on the report, named TYPE_Atxt, TYPE_Btxt, TYPE_Ctxt, TYPE_Dtxt. These
unbound fields are the ones that will be populated with the rank and values, and will be visible on the report.
You could make the unbound fields just contain the rank, and put them beside the linked fields and make the linked fields visible. I just didn't choose to do it that way.
It basically works like I said.
Stores the values in the recordset and then sorts the rs rows descending.
Assigns ranking to each row, allowing for duplicated values.
Passes back through the recordset assigning values to the different unbound controls, based upon their names, and the names stored in the recordset.
I have tested it with several different value sets and it seems to work in all of them.
It did turn into more than "30 or so" lines of code, but they always do, don't they?
Good luck with your project.
Let me know if something doesn't work right.
Oh yeah, I put it in the print event instead of the format.
Tranman
Code:
Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
Dim ctrl As Control
Dim intInc As Integer
Dim intRank As Integer
Dim sglValue As Single
Dim rs As New ADODB.Recordset
'Add new recordset fields
rs.Fields.Append "NAME", adChar, 6
rs.Fields.Append "VALUE", adSingle
rs.Fields.Append "RANK", adSingle
rs.Open
'Add the new rows to the recordset
rs.AddNew
rs.Fields("NAME") = "TYPE_A"
rs.Fields("VALUE") = Me.TYPE_A
rs.AddNew
rs.Fields("NAME") = "TYPE_B"
rs.Fields("VALUE") = Me.TYPE_B
rs.AddNew
rs.Fields("NAME") = "TYPE_C"
rs.Fields("VALUE") = Me.TYPE_C
rs.AddNew
rs.Fields("NAME") = "TYPE_D"
rs.Fields("VALUE") = Me.TYPE_D
'Sort the recordset descending
rs.Sort = "VALUE desc"
'Assign the first rank and move to the next row
rs.MoveFirst
intRank = 1
sglValue = rs.Fields("VALUE")
rs.Fields("RANK") = 1
rs.Update
rs.MoveNext
'Assign the subsequent ranks
Do While Not rs.EOF
Select Case rs.Fields("VALUE")
Case Is = sglValue
rs.Fields("RANK") = intRank
intInc = intInc + 1
sglValue = rs.Fields("VALUE")
Case Else
intRank = intRank + intInc + 1
rs.Fields("RANK") = intRank
sglValue = rs.Fields("VALUE")
intInc = 0
End Select
rs.Update
rs.MoveNext
Loop
'Plug the values into the unbound controls
rs.MoveFirst
Do While Not rs.EOF
For Each ctrl In Me.Controls
If Left(ctrl.Name, 6) = rs.Fields("NAME") And Right(ctrl.Name, 3) = "txt" Then
ctrl = "(" & rs.Fields("RANK") & ") " & rs.Fields("VALUE")
End If
Next
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Sub