Problem with Cycling through code to return a value for a query

Hi Karen

I'm having difficulty following what your code is supposed to be doing, because I can't see the SQL of the queries it is reading from.  However, it seems to me that your cont: label is in the wrong place.  Try moving it down to line #70, just before rs.MoveNext.  It is not doing anything where it is, because without the GoTos the code would still proceed to the same place.

The real problem here is that your data is not normalised.  if you had a table with one tier per record, it would be an easy matter to find the first tier value that is greater that a given PctYrlyIncrease value for a given quarter.  You could do it all in SQL and would not need a VBA function.

Best wishes,
Graham Mandeno [Access MVP 1996-2014]

I did normalize it via a Union query to limit the data to the following table structure

ContractNumber
Quarter,
PctYrlyIncrease,
TotalNetUSExp,
totatl
Tier1
Tier2
Tier3
Tier4
Tier5
Tier6.

See the picture above.

Since my last posting I have revised my code:

I have since started with comparing the value of the PctYrlyIncrease the value of Tier6(since this is usually the highest value) and if the PctyrlyIncreasse > tier6, do the equation of TotalNetUSExp * TIE6 (from the second recordset)

Else if the PctyrlyIncrease < Tier6 then

ComPare the values of each Tier (1-6) until PctyrlyIncrease < but not > the next tier level then
TotalNetUSExp * Depending on the tier number which (T1E?) value used.

example:  
TotalNetUSExp = 10000.00
T1E1 = 25.00
PctyrlyIncrease    Tier1          Tier2             Tier3
 33.40%                 5.00         10.00            35.00

if 33.40 > 5.00% but < 35.00% then
10000 * 25.00 = 250000
Else move to the next tier.

NOTE: 2 ISSUES STILL RAISING IT UGLY HEAD:

This portion is not return the correct results ( something to due with the AND i believe)
                           ElseIf nfld > nfld1 And nfld < nfld2 = True Then

Also:


Also a typemismatch somewhere.


Hope this helps explain things better.
Here is my revised Query that calls this function:

SELECT TOP 25 qrySummaryExpectation_Detail.ContractNumber, qrySummaryExpectation_Detail.Quarter, qrySummaryExpectation_Detail.ORType, qrySummaryExpectation_Detail.TotalNetUSExp, qrySummaryExpectation_Detail.PctYrlyIncrease, IIf([PctYrlyIncrease]=0,BkOvrCalc([qrySummaryExpectation_Detail].[contractNumber]),IIf([PctYrlyIncrease]>[Tier6],[TotalNetUSExp]*[T6E],0)) AS OvtAmount, qryBkOverRide_Normalized.Tier1, qryBkOverRide_Normalized.Tier2, qryBkOverRide_Normalized.Tier3, qryBkOverRide_Normalized.Tier4, qryBkOverRide_Normalized.Tier5, qryBkOverRide_Normalized.Tier6
FROM (qrySummaryExpectation_Detail INNER JOIN qryBkOverRide_Normalized ON (qrySummaryExpectation_Detail.Quarter = qryBkOverRide_Normalized.Quarter) AND (qrySummaryExpectation_Detail.ContractNumber = qryBkOverRide_Normalized.ContractNumber)) INNER JOIN qryOverride_AccountTotals ON qrySummaryExpectation_Detail.ContractNumber = qryOverride_AccountTotals.ContractNumber;

Note the If Statement:

IIf([PctYrlyIncrease]=0,BkOvrCalc([qrySummaryExpectation_Detail].[contractNumber]),IIf([PctYrlyIncrease]>[Tier6],[TotalNetUSExp]*[T6E],0)) AS OvtAmount,

Public Function BkOvrCalc(ByVal gContractID As String) As Long
Dim curDB As DAO.Database
Dim strSQL As String, strSQL1 As String
Dim rs As DAO.Recordset, rs1 As DAO.Recordset
Dim strField As String, strNextField As String
Dim strfld As String, strfldNext As String
Dim nTr As Long
Dim nfld As String, nfld1 As String, nfld2 As String
Dim x As Integer, i As Integer
Dim nTierNo As String, nTier6 As String
Dim nOvrAmt As Currency

   On Error GoTo BkOvrCalc_Error

Set curDB = CurrentDb

    'delete current data from tblOverride_ExpectQtrlyTotals
    curDB.Execute ("Delete * from tblOverride_ExpectQtrlyTotals")
    
    'List of all Contracts and Quarters Totals for calculation of Override Dollars by Tier%
    strSQL = "SELECT *" & _
                    " FROM qryOverride_Calc" & _
                    " Where ContractNumber = " & Chr(34) & gContractID & Chr(34) & ""
    Set rs = curDB.OpenRecordset(strSQL)
    
    'List of all Contracts and AccountPercentage, Account Dollars & Payout Percentage
    strSQL1 = "SELECT *" & _
                    " FROM qryOverride_AccountTotals" & _
                    " Where ContractNumber = " & Chr(34) & gContractID & Chr(34) & ""
    Set rs1 = curDB.OpenRecordset(strSQL1)
    
    'rs.MoveFirst
    Do Until rs.EOF
        ' Override Code Type
        x = rs.Fields("ORType")
        nfld = rs.Fields("PctYrlyIncrease").Value
        nfld = Format((nfld), "Percent")
        nTier6 = Format(rs.Fields("Tier6").Value, "Percent")
          Debug.Print "contractNo:" & gContractID
          Debug.Print "nfld: " & nfld
            Debug.Print "nTier6:" & nTier6
        Select Case x ' OverRide Type
            Case 1 'Quarters
'               If nfld = 0# Then
'                    nOvrAmt = 0
'                    BkOvrCalc = nOvrAmt
'                    rs.MoveNext
'               Else
               If nfld > nTier6 Then
                    nOvrAmt = rs.Fields("TotalNetUSExp").Value * rs1.Fields("T6E").Value
                    BkOvrCalc = nOvrAmt
                    rs.MoveNext
                ElseIf nfld < nTier6 Then
                   For nTr = 1 To 4
                       'determine which Tier value to use
                       nTierNo = "Tier" & nTr
                       strNextField = "Tier" & nTr + 1
                       'Determine the % Payout:
                       strfld = "T" & nTr & "E"
                       strfldNext = "T" & nTr + 1 & "E"
                            nfld1 = Format(rs.Fields(nTierNo).Value, "Percent")
                            nfld2 = Format(rs.Fields(strNextField).Value, "Percent")
                           Debug.Print "nfld1:" & nfld1
                           Debug.Print "nfld2:" & nfld2
                           If nfld > nfld1 Then
                               nOvrAmt = 0
                               BkOvrCalc = nOvrAmt
                               GoTo cont:
                           ElseIf nfld > nfld1 And nfld < nfld2 = True Then
                               nOvrAmt = rs.Fields("TotalNetUSExp") * rs1.Fields(strfld).Value
                               BkOvrCalc = nOvrAmt
                               GoTo cont:
                           End If
cont:
                    nTr = nTr + 1
                    Next nTr
                End If
            Case 2 'Annual Flat%
            Case 3 'Annual Flat$
        End Select

        rs.MoveNext
    Loop
onExit:
Set rs = Nothing
    Set rs1 = Nothing
    rs1.Close
    rs1.Close

   On Error GoTo 0
   Exit Function

BkOvrCalc_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure BkOvrCalc of Module basUtilities"

End Function

Select allOpen in new window

thanks guys