do Loops - Not looping thru all records

[kfschaefer1]

I have a function that is called from a query. I need to loop thru the same Contractnumber, but for 4 different Quarters to return different values for the function (4 records total). I seems to Loop thru the first 2 quarters but the return value does not change and the final results display the last result for all 4 quarters. See attachment.

How do I get it to loop thru the correct number of quarters and to return the different values needed?



Attachment 15783

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 x As Integer
Dim nOvrAmt As Currency
Dim intUseTier As Integer
Dim dblMultiplier As Double


   On Error GoTo BkOvrCalc_Error


Set curDB = CurrentDb


    'List of all Contracts and Quarters Totals for calculation of Override Dollars by Tier%
    strSQL = "SELECT qrySummaryExpectation_Detail.ContractNumber, qrySummaryExpectation_Detail.Quarter," & _
                " qrySummaryExpectation_Detail.ORType, TotalNetUSExp, PctYrlyIncrease," & _
                " Tier1, Tier2, Tier3, Tier4, Tier5, Tier6" & _
            " FROM qrySummaryExpectation_Detail INNER JOIN qryBkOverRide_Normalized ON" & _
                " (qrySummaryExpectation_Detail.Quarter = qryBkOverRide_Normalized.Quarter) AND" & _
                " (qrySummaryExpectation_Detail.ContractNumber = qryBkOverRide_Normalized.ContractNumber)" & _
            " WHERE (((qrySummaryExpectation_Detail.ContractNumber)='00010674'))"
     Set rs = curDB.OpenRecordset(strSQL)
    
    'List of all Contracts and AccountPercentage, Account Dollars & Payout Percentage
    strSQL1 = "SELECT ContractNumber, ORType, T1E, T2E, T3E, T4E, T5E, T6E," & _
                " AT1Per, AT2Per, AT3Per, AT4Per, AT5Per, AT6Per," & _
                " AT1Dol, AT2Dol, AT3Dol, AT4Dol, AT5Dol, AT6Dol" & _
            " FROM tblContracts" & _
            " 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")
        Debug.Print rs!Quarter
        Debug.Print gContractID
        Select Case x ' OverRide Type
            Case 1 'Quarters
                intUseTier = fnTier(rs!PctYrlyIncrease, rs!Tier1, rs!Tier2, rs!Tier3, rs!Tier4, rs!Tier5, rs!Tier6)
                Debug.Print intUseTier
                dblMultiplier = IIf(intUseTier = 0, 0, rs1.Fields("T" & intUseTier & "E"))
                Debug.Print dblMultiplier
                nOvrAmt = rs.Fields("TotalNetUSExp") * dblMultiplier
            Case 2 'Annual Flat%
            Case 3 'Annual Flat$
        End Select
        Debug.Print nOvrAmt


        rs.MoveNext
    Loop
        BkOvrCalc = nOvrAmt


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


   On Error GoTo 0
   Exit Function


BkOvrCalc_Error:


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


End Function

Public Function fnTier(TestVal As Double, ParamArray TierValues() As Variant) As Integer


    Dim intLoop As Integer
    
    For intLoop = LBound(TierValues) To UBound(TierValues)
        If TestVal <= TierValues(intLoop) Then
            fnTier = intLoop
            Exit Function
        End If
    Next
    
    fnTier = intLoop
    
End Function

[June7]

Your attachment link doesn't work. Do you want to provide db for analysis? Follow instructions at bottom of my post.