Mark Andrews said:
Dirk,
Thanks for helping out. I have one query that calls this function and
returns ContactID and DonorLevel.
I use the first query in a second query to calculate totals by donor
level.
My function is as follows:
Public Function LookupDonorLevel(TotalCollected As Double) As String
On Error GoTo Err_LookupDonorLevel
Dim rs As DAO.Recordset
Dim txtDonorLevel As String
Set rs = CurrentDb.OpenRecordset("tblPreferences", dbOpenDynaset)
If Not (rs.BOF And rs.EOF) Then
rs.MoveFirst
If (TotalCollected <= rs("DonorLevel1End")) Then
txtDonorLevel = rs("DonorLevel1Name")
ElseIf (TotalCollected <= rs("DonorLevel2End")) Then
txtDonorLevel = rs("DonorLevel2Name")
ElseIf (TotalCollected <= rs("DonorLevel3End")) Then
txtDonorLevel = rs("DonorLevel3Name")
ElseIf (TotalCollected <= rs("DonorLevel4End")) Then
txtDonorLevel = rs("DonorLevel4Name")
ElseIf (TotalCollected <= rs("DonorLevel5End")) Then
txtDonorLevel = rs("DonorLevel5Name")
ElseIf (TotalCollected <= rs("DonorLevel6End")) Then
txtDonorLevel = rs("DonorLevel6Name")
ElseIf (TotalCollected <= rs("DonorLevel7End")) Then
txtDonorLevel = rs("DonorLevel7Name")
ElseIf (TotalCollected <= rs("DonorLevel8End")) Then
txtDonorLevel = rs("DonorLevel8Name")
Else
txtDonorLevel = ""
End If
End If
rs.Close
LookupDonorLevel = txtDonorLevel
Exit_LookupDonorLevel:
Set rs = Nothing
Exit Function
Err_LookupDonorLevel:
MsgBox Err.Description
Resume Exit_LookupDonorLevel
End Function
If I were doing this, I would have the DonorLevels defined in a table with
one record per level and fields like these:
DonorLevelName (text, primary key)
DonorLevelStart (currency, indexed w/no duplicates)
DonorLevelEnd (currency, indexed w/no duplicates)
DonorLevelStart would be the dollar value of the low end of this donor
level, and DonorLevelEnd would be the high end. Technically, you only need
one of these fields, but it makes the SQL simpler if you have both.
With a table like that, I could determine the DonorLevel for any given
donation total without any code at all, using straight SQL:
------ start of "air SQL" ------
SELECT
Donors.ContactID,
Donors.TotalDonation,
DonorLevels.DonorLevel
FROM
(
SELECT
tblDonation.ContactID,
Sum(DonationAmount) AS TotalDonation
FROM tblDonation INNER JOIN qryFilter
ON tblDonation.ContactID = qryFilter.ContactID
GROUP BY tblDonation.ContactID)
) AS Donors
LEFT JOIN
DonorLevels
ON Donors.TotalDonation
BETWEEN DonorLevels.DonorLevelStart
AND DonorLevels.DonorLevelEnd
ORDER BY Donors.DonorLevel
------ end of "air SQL" ------
If you don't choose to go that route, and you want to retain your function,
you can fix the big problem you're having with performance by not opening
and closing a recordset to return the same data each time the function is
called. That's easy enough; just collect the information in static
variables, checking in each function call to see if you need to reload them:
'------ start of (alternative) revised code ------
Public Function LookupDonorLevel(TotalCollected As Double) As String
On Error GoTo Err_LookupDonorLevel
Static L1End As Variant, L1Name As String
Static L2End As Variant, L2Name As String
Static L3End As Variant, L3Name As String
Static L4End As Variant, L4Name As String
Static L5End As Variant, L5Name As String
Static L6End As Variant, L6Name As String
Static L7End As Variant, L7Name As String
Static L8End As Variant, L8Name As String
Dim rs As DAO.Recordset
Dim txtDonorLevel As String
If IsEmpty(L1End) Then
Set rs = CurrentDb.OpenRecordset("tblPreferences", dbOpenSnapshot)
With rs
If .EOF Then
L1End = 0
L2End = 0
L3End = 0
L4End = 0
L5End = 0
L6End = 0
L7End = 0
L8End = 0
Else
L1End = !DonorLevel1End : L1Name = !DonorLevel1Name
L2End = !DonorLevel2End : L2Name = !DonorLevel2Name
L3End = !DonorLevel3End : L3Name = !DonorLevel3Name
L4End = !DonorLevel4End : L4Name = !DonorLevel4Name
L5End = !DonorLevel5End : L5Name = !DonorLevel5Name
L6End = !DonorLevel6End : L6Name = !DonorLevel6Name
L7End = !DonorLevel7End : L7Name = !DonorLevel7Name
L8End = !DonorLevel8End : L8Name = !DonorLevel8Name
End If
.Close
End With
Set rs = Nothing
End If
Select Case TotalCollected
Case Is <= L1End : txtDonorLevel = L1Name
Case Is <= L2End : txtDonorLevel = L2Name
Case Is <= L3End : txtDonorLevel = L3Name
Case Is <= L4End : txtDonorLevel = L4Name
Case Is <= L5End : txtDonorLevel = L5Name
Case Is <= L6End : txtDonorLevel = L6Name
Case Is <= L7End : txtDonorLevel = L7Name
Case Is <= L8End : txtDonorLevel = L8Name
Case Else : txtDonorLevel = ""
End Select
LookupDonorLevel = txtDonorLevel
Exit_LookupDonorLevel:
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Exit Function
Err_LookupDonorLevel:
MsgBox Err.Description
Resume Exit_LookupDonorLevel
End Function
'------ end of code ------
The above code could doubtless be made less repetitive through the use of an
array, but you you get the idea -- and besides, it probably wouldn't be any
more efficient.
Note that, if you change the donor levels in the table, you'd need to exit
and re-enter the database, or reset the VB project, to get the new donor
levels to be loaded into the static variables. If that's not desirable, you
can add an argument to the function that would serve as a flag to force the
levels to be reloaded.
