IF statement vs Loops

To determine the appropriate tier to assign a value to, I would use a function, like below:

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

Select allOpen in new window

I believe, using your code and screenshot as an example, I would call this function like:

Dim intUseTier as integer
Dim dblMultiplier as double

intUseTier = fnTier(rs!PctYrlyIncrease, rs!Tier1, rs!Tier2, rs!Tier3, rs!Tier4, rs!Tier5, rs!Tier6)
dblMultiplier = iif(intUseTier = 0, 0, rs1.Fields("T" & intUseTier & "E")
nOvrAmt = rs.Fields("TotalNetUSExp") * dblMultiplier

Select allOpen in new window

 I believe this would replace most of the code inside the "Case 1" section of your code.

Hi,

pls see correction (marked with EDITED)

You don't say what should be done if the values are equal

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 nfld As Long, nfld1 As Long, nfld2 As Long
Dim nTierNo As String, nTier6 As Double
Dim nTr As Integer
Dim x As Integer
Dim nOvrAmt As Currency

   On Error GoTo BkOvrCalc_Error

Set curDB = CurrentDb

    'List of all Contracts and Quarters Totals for calculation of Override Dollars by Tier%
    strSQL = "SELECT ContractNumber, Quarter, 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'))"

    '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 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")
        nfld = rs.Fields("PctYrlyIncrease").Value
        nTier6 = rs.Fields("Tier6").Value
          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
                    'GoTo cont: EDITED
                ElseIf nfld > nTier6 Then   'EDITED
                    nOvrAmt = rs.Fields("TotalNetUSExp") * rs1.Fields("T6E").Value
                    BkOvrCalc = nOvrAmt
                    'GoTo cont: EDITED
                Else ' If nfld <= nTier6 Then ' EDITED
                   For nTr = 5 To 1 Step -1 ' EDITED
                       '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 = rs.Fields(nTierNo).Value
                            nfld2 = rs.Fields(strNextField).Value
                           Debug.Print "nfld1:" & nfld1
                           Debug.Print "nfld2:" & nfld2
                           
                           If nfld > nfld1 And nfld < nfld2 = True Then  ' EDITED
                               nOvrAmt = rs.Fields("TotalNetUSExp") * rs1.Fields(strfld).Value
                               BkOvrCalc = nOvrAmt
                               Exit For ' EDITED
                           ElseIf nfld < nfld1 Then 'EDITED
                               nOvrAmt = 0
                               BkOvrCalc = nOvrAmt
                               Exit For ' EDITED
                           End If
                    ' nTr = nTr + 1 EDITED if you have "for next" you do not need this
                    Next nTr
                End If
            Case 2 'Annual Flat%
            Case 3 'Annual Flat$
        End Select
'cont: EDITED

        rs.MoveNext
    Loop

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

Select allOpen in new window

Regards

Hi Karen

There are several big problems with your code:

1. In line #23 you are filtering by a specific contract number ('00010674') when I believe you should be selecting the contract passed in your argument, gContractID:

     " WHERE qrySummaryExpectation_Detail.ContractNumber='" & gContractID & "'"

Select allOpen in new window

2. In line 81, you are incrementing your loop variable, nTr, and then it will be incremented again by the Next nTr on the following line.  
This means that your For nTr = 1 to 4 loop will be executed only twice, for values 1 and 3.

3. The block of code in lines 77-79 will never be executed, for the following reason:
If nfld > nfld1 is True, then the first block (lines 73-75) will be executed.  Therefore, if we get to line 76, nfld > nfld1 is False.  What you are effectively saying, then, at line 76 is:
If False And (nfld < nfld2 = True)

Now, False And <something> can never be True, so that second part of the If ... Then ... Else will never run.

4. Your main loop (lines 39-90) will execute once for every record in rs.  For each of these iterations, a new value of the function return value (BkOvrCalc) is calculated.  This means that only the value from the last record (latest quarter?) will be returned.

I haven't yet delved in to the finer logic of the code, but these major problems should certainly be fixed before anything will work.

Also, as I mentioned in at least one other thread, your data is not normalised, and I'm sure this would be 100 times easier if it were.

Best wishes,
Graham

Dale,

I like the look of your code, except I am getting a couple of errors.

and I am calling this function from within a Query, and it is returning the same value, instead of a new value for each row/calculation.

I tried moving the bkOvrAmt value within the loop and outside of the loop without success.

these are the results I am expecting

 $2,406,632.39       3.00%       $72,198.97
 $1,211,897.84       0.00%       $-  
 $1,306,707.02       0.50%       $6,533.54
 $1,104,308.21       1.00%       $11,043.08

But getting:


Also note the error msg.

Here is my revised code:

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 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)
                dblMultiplier = IIf(intUseTier = 0, 0, rs1.Fields("T" & intUseTier & "E"))
                nOvrAmt = rs.Fields("TotalNetUSExp") * dblMultiplier
            Case 2 'Annual Flat%
            Case 3 'Annual Flat$
        End Select

        BkOvrCalc = nOvrAmt
        rs.MoveNext
    Loop
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

Select allOpen in new window

Graham

In line #23 you are filtering by a specific contract number ('00010674') when I believe you should be selecting the contract passed in your argument, gContractID:

Was for testing purposes.

Also, as I mentioned in at least one other thread, your data is not normalised, and I'm sure this would be 100 times easier if it were.

What about my data is normalized - I changed it to the above format using Union Queries.  this is the best of a bad situation.
I took the majority of the original data a complied it down to 6 Tier columns per quarter instead of 36 fields - a Qtr/Tiers 1 for each Tier and each Quarter.  How much more can I normalize than that.

Your main loop (lines 39-90) will execute once for every record in rs.  For each of these iterations, a new value of the function return value (BkOvrCalc) is calculated.  This means that only the value from the last record (latest quarter?) will be returned.

Where do you recommend the placement of the BkOvrCalc = nOvrAmt?

thanks for you great input.  it is most beneficial.

Not looping thru all quarters and not return unique values for each quarter?  What am I missing?
  I have been playing with the placement of the return  value - not making a difference

    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

Select allOpen in new window

Karen,

Without seeing the query SQL, I cannot explain why you are getting that result.  For one thing, the function will only return a numeric value, so I'm not sure how you are referencing that value in your query, can you post your SQL?

Are the values you displayed above what gets printed out in the debug.print statements in the code immediately preceding this response?

Are the values you displayed above what gets printed out in the debug.print statements in the code immediately preceding this response?

Yes the debug shows that the first quarter returns


Qtr: 1
contractNo: 00010674
intUseTier:  6
dblMultiplier: 0.03
nOvrAmt: 72198.9718

then moves to Next rs
Qtr: 2
contractNo: 00010674
 intUseTier: 0

then sets the bkoverCalc = nOvrAmt

the starts over at Qtr1.

    'List of all Contracts and Quarters Totals for calculation of Override Dollars by Tier%
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
    

Select allOpen in new window

Hi Karen

You have four (maybe more) records in rs - one for each quarter.   Your main loop code is processing only one of these records at a time.

Big Question:  What do you want your function to do?

Do you want it to return a separate value for each quarter?  If so, then you must pass the quarter as well as the contract number to your function, so that you process only one record at a time.

Do you want it to process all the quarters and somehow select the "best" value to return?  If so, then what are the criteria for selecting the best value?

I sympathise with the problem you are facing with regard to normalisation.  Often, data which comes from elsewhere - particularly spreadsheets - is atrociously un-normalised.  The tipping point on deciding whether to make do with the data as it is, or transpose it into normalised tables, often comes down to efficiency.

I have a bad feeling about this query you are building.  You seem to have a query which calls a function for each record which opens two recordsets (which, in turn, are based on union queries) and loops through one of them using a nested loop to select and use the appropriate column for a calculation.  Even on a super-computer, this ain't going to be fast!

It would certainly help enormously if you could upload a sample of your database, perhaps with the data for just one or two contracts.  At the moment, much of your question is still in your head and, speaking for myself, we are not mind readers - particularly on the other side of the planet!  :-)

Best wishes,
Graham

Do you want it to return a separate value for each quarter?  If so, then you must pass the quarter as well as the contract number to your function, so that you process only one record at a time.

I want a value for each quarter per each contract.  so should I limit the first sql statement to include a Qtr no?

I put together a sample mdb but it will take some time.  Thanks for your great advice.

K

the  function can be found in basUtilities -  BkOvrCalc -

Query that calls the function - "qryOverride_Calc"
"TblContracts" basis of queries (data samples)

the normalized query of the "qryBkOverRide_Normalized"

the set of code Include the handling of the Tier data comparison the Dale recommended.

Again Thanks for all your time.
K
TestSample.zip

sample database would be good.

Let me get this right, you are calling the BkOvrCalc( ) function from a query?  In that case, I would agree with Graham that you would need to pass the contract #, year, and quarter into your function, and restrict you initial recordset (rs) using a WHERE clause that filters on contract#, year, and quarter.  With that, you would only have one record to process.

Also, I strongly agree with Graham that normalizing your data would make this so.... much easier.  If your raw data (or even a query) could force the Tier fields into a single field, like:

Contract#   Year    Quarter    Tier    TierValue

Hi Karen

I want a value for each quarter per each contract.  so should I limit the first sql statement to include a Qtr no?

Yes, in that case you should definitely pass the Quarter number as well as the Contract number to your function, and use them both in your WHERE clause for your main recordset.

If I understand your logic correctly, this should then return at most one record, so you will not need the main loop.

Also, you are returning 20 columns for rs1, when actually you only need ONE.  I would delay opening rs1 until you have selected the Tier, then select only the required column.

I look forward to seeing your sample DB :-)

- Graham

Did you get the sample?  I posted about 1/2 hr ago.

Ok I create the Normalizing query per your suggestion, how should I proceed with the new data in the recommended format?

Yes, I have it thanks, Karen.  I saw it there after I posted my last message.  I just had something important to do first - take the dog to the beach for our morning swim :-)

I have some ideas about how to improve the code, which I'll post later.

Cheers,
Graham

Here is a copy of my new normalized query, hope this helps:

SELECT tblContracts.ContractNumber, 1 AS qtr, 1 AS Tier, tblContracts.Q1T1 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q1T1) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 1 AS qtr, 2 AS Tier, tblContracts.Q1T2 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q1T2) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 1 AS qtr, 3 AS Tier, tblContracts.Q1T3 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q1T3) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 1 AS qtr, 4 AS Tier, tblContracts.Q1T4 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q1T4) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 1 AS qtr, 5 AS Tier, tblContracts.Q1T5 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q1T5) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 1 AS qtr, 6 AS Tier, tblContracts.Q1T6 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q1T4) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 2 AS qtr, 1 AS Tier, tblContracts.Q2T1 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q1T6) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 2 AS qtr, 2 AS Tier, tblContracts.Q2T2 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q2T2) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 2 AS qtr, 3 AS Tier, tblContracts.Q2T3 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q2T3) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 2 AS qtr, 4 AS Tier, tblContracts.Q2T4 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q2T4) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 2 AS qtr, 5 AS Tier, tblContracts.Q2T5 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q2T5) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 2 AS qtr, 6 AS Tier, tblContracts.Q2T6 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q2T6) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 3 AS qtr, 1 AS Tier, tblContracts.Q3T1 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q1T1) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 3 AS qtr, 2 AS Tier, tblContracts.Q3T2 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q3T2) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 3 AS qtr, 3 AS Tier, tblContracts.Q3T3 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q3T3) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 3 AS qtr, 4 AS Tier, tblContracts.Q3T4 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q3T4) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 3 AS qtr, 5 AS Tier, tblContracts.Q3T5 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q3T5) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 3 AS qtr, 6 AS Tier, tblContracts.Q3T6 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q3T6) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 4 AS qtr, 1 AS Tier, tblContracts.Q3T1 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q4T1) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 4 AS qtr, 2 AS Tier, tblContracts.Q3T2 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q4T2) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 4 AS qtr, 3 AS Tier, tblContracts.Q3T3 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q4T3) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 4 AS qtr, 4 AS Tier, tblContracts.Q4T4 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q4T4) Is Not Null))
Union
SELECT tblContracts.ContractNumber, 4 AS qtr, 5 AS Tier, tblContracts.Q3T5 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q4T5) Is Not Null))
UNION SELECT tblContracts.ContractNumber, 4 AS qtr, 6 AS Tier, tblContracts.Q4T6 AS TierAmt
FROM tblContracts
WHERE (((tblContracts.Q4T6) Is Not Null));

Select allOpen in new window

Dale, Thanks for the great input and your time.

Karen

I've just read yours and Dale's comments, posted while I was playing with creating that code for you.

I agree 100% that normalisation is the best way for you to go.  However, you don't only have a problem with the QxTn fields (of which there are 24!)  You also have:




All of these are problematic, and may cause severe headaches in the future.  What will happen, for example, if someone decides you should have a seventh tier?  The repercussions to your entire application are unthinkable!

I would recommend you break these four sets of repeating fields out into four separate tables, each related to tblContracts by ContractNumber.  It will seem like a lot of work, but you'll thank yourself for it in the end :-)

Also, you should do your best to avoid using UNION queries to present badly formed data in a normalised view.  A normalising UNION query running over more than a few hundred records can be very slow!

Cheers,
Graham

Graham,

It seems to be doing the trick, however, I realized that I will be unable to use it for the last 2 portions of the CASE statement, due to the fact I will not be needing the Quarters to determine those values.  So I plan on creating a total of 3 functions to handle the different OR_types and the values to be  used instead of the Tiers 1-6.  I will need to use the AT1-6Per fields to compare against the PctYrlyIncrease value and I will need the sum of the TotalNetUSExp  for those Contracts where OrType = 2,

then the same for OrType = 3 , except I will be using the AT1-6Dol fields to compare against the PctYrlyIncrease values.

I am calling quits for the night and will pick this up in the morning.  I really appreciate all your efforts, have a good night.

thanks,

karen

Graham,  I know this whole database is a mess, however, I was only hire to make another patch, hence the need to make it work as is.  I have made several recommendations to improve the mdb, like not use an mdb.  change to BI objects, since the data is coming from Oracle Datawarehouse.  But that is not in the budget for this year.  You wouldn't believe how this database  has been patched together over the  years.  I just need to get the calculations and reports working for the current  year.  And this is my last week on this project before I move on.

Thanks again.

Hi Karen

Believe me, I know very well the headaches and hair loss associated with inheriting a massive flat-file or badly-designed database.  You have my heartfelt sympathy!

G :-)

Graham,

Ok after trying to get 3 different versions developed.  I am having an issue with the original.

        sSQL = sSQL & ", Q" & Quarter & "T" & i & " as T" & i & ", T" & i & "E"
    Next i
    sSQL = sSQL & " FROM tblContracts" & _
                  " WHERE (ContractNumber= '" & ContractID & "');"
     Set rs = curDB.OpenRecordset(sSQL, dbOpenForwardOnly)
    If rs.EOF Then
        BkOvrFactor = 0 ' no record - return zero
    Else
        ' Override Code Type
        Select Case rs!ORType ' OverRide Type
            Case 1 'Quarters
                For i = 1 To 6
                    If PctYrlyIncrease < rs("T" & i) Then Exit For

Select allOpen in new window

                   If PctYrlyIncrease < rs("T" & i) Then Exit For

Needs to be PctYrlyincrease < Q1T1, etc.

I tried formatting the rs("T" & i) and not having much luck

            nQTR = "Q" & Quarter & "T" & i & ""
          If PctYrlyIncrease < rs.Fields("nQTR").Value Then Exit For
          Debug.Print PctYrlyIncrease
          Debug.Print rs.Fields(nQTR).Value

Select allOpen in new window

What am I missing?

also for some reason the For i = 1 to 6, at some points the i >6, this should happen correct.  I was stepping thru the code I notice the increments increasing beyond 6.

Nevermind figured it out, miss read how the code was working. here is my final code:

Public Function BkOvrCalc( _
        ByVal ContractID As String, _
        ByVal Quarter As String, _
        ByVal PctYrlyIncrease As Double) _
    As Double
Dim curDB As DAO.Database
Dim strSQL As String
Dim rs As DAO.Recordset
Dim iUseTier As Integer, i As Integer
Dim nQTR As Double

On Error GoTo onError

    Set curDB = CurrentDb

    'List of all Contracts and Quarters Totals for calculation of Override Dollars by Tier%
    strSQL = "SELECT ContractNumber, ORType"
        For i = 1 To 6
            strSQL = strSQL & ", Q" & Quarter & "T" & i & " as T" & i & ", T" & i & "E"
        Next i
    strSQL = strSQL & " FROM tblContracts" & _
                  " WHERE (ContractNumber= '" & ContractID & " ');"
    Set rs = curDB.OpenRecordset(strSQL, dbOpenForwardOnly)
    'Debug.Print strSQL
    If rs.EOF Then
        BkOvrCalc = 0 ' no record - return zero
    Else
        For i = 1 To 6
     '   Debug.Print "T" & i & ":" & rs("T" & i)
        If PctYrlyIncrease < rs("T" & i) Then Exit For
        Next i
        iUseTier = i - 1
        If iUseTier = 0 Then
            BkOvrCalc = 0
        Else
     '       Debug.Print rs("T" & iUseTier & "E")
            BkOvrCalc = rs("T" & iUseTier & "E")
        
        End If
    End If

onExit:
    On Error Resume Next ' you don't want an error to stop your cleanup
        If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Function

onError:

 '   MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure BkOvrCalc of Module basUtilities"
    Resume onExit
  
End Function
Public Function BkOvrATPerCalc(ByVal ContractID As String, ByVal PctYrlyIncrease As Double) As Double

Dim curDB As DAO.Database
Dim strSQL As String
Dim rs As DAO.Recordset
Dim iUseTier As Integer, i As Integer

On Error GoTo onError

    Set curDB = CurrentDb

    'List of all Contracts and AT?Per Totals for calculation of Override Account Percentage
    strSQL = "SELECT *"
        For i = 1 To 6
            strSQL = strSQL & ", AT" & i & "Per, T" & i & "E"
        Next i
    strSQL = strSQL & " FROM tblContracts" & _
                  " WHERE (ContractNumber= '" & ContractID & "');"
    'Debug.Print strSQL
    Set rs = curDB.OpenRecordset(strSQL, dbOpenForwardOnly)
    If rs.EOF Then
        BkOvrATPerCalc = 0 ' no record - return zero
    Else
        For i = 1 To 6
          If PctYrlyIncrease < rs("AT" & i & "PER") Then Exit For
        Next i
        iUseTier = i - 1
        If iUseTier = 0 Then
            BkOvrATPerCalc = 0
        Else
            BkOvrATPerCalc = rs("T" & iUseTier & "E")
        End If
    End If

onExit:
    On Error Resume Next ' you don't want an error to stop your cleanup
        If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Function

onError:
  
  'MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure BkOvrATPerCalc of Module basUtilities"
    Resume onExit
End Function
Public Function BkOvrATDOLCalc(ByVal ContractID As String, ByVal pTotalExp As Double) As Double

Dim curDB As DAO.Database
Dim strSQL As String
Dim rs As DAO.Recordset
Dim iUseTier As Integer, i As Integer

On Error GoTo onError

    Set curDB = CurrentDb

    'List of all Contracts and AT?Per Totals for calculation of Override Account Percentage
    strSQL = "SELECT *"
        For i = 1 To 6
            strSQL = strSQL & ", AT" & i & "DOL, T" & i & "E"
        Next i
    strSQL = strSQL & " FROM tblContracts" & _
                  " WHERE (ContractNumber= '" & ContractID & "');"
    'Debug.Print strSQL
    Set rs = curDB.OpenRecordset(strSQL, dbOpenForwardOnly)
    If rs.EOF Then
        BkOvrATDOLCalc = 0 ' no record - return zero
    Else
        For i = 1 To 6
          'If PctYrlyIncrease < rs("AT" & i & "DOL") Then Exit For
        Next i
        iUseTier = i - 1
        If iUseTier = 0 Then
            BkOvrATDOLCalc = 0
        Else
            BkOvrATDOLCalc = rs("T" & iUseTier & "E")
        End If
    End If

onExit:
    On Error Resume Next ' you don't want an error to stop your cleanup
        If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Function

onError:

    MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure BkOvrATDOLCalc of Module basUtilities"
    Resume onExit
End Function

Select allOpen in new window

Most Excellent help,  Graham was a life saver,  Thank you so much for all your time and efforts.

Thanks, Karen!  I'm glad it all came together in the end :-)

Just to clarify a couple of questions from your posts this morning:

1. The SQL string is aliasing the QxTn fields to simply "Tn" - for example:
        SELECT ... Q3T1 AS T1, T1E, Q3T2 As T2, T2E, ...
    That way, in the comparison loop you just need to compare with rs("T" & i),
    instead of rs("Q" & Quarter & "T" & i)

2.  If a For ... Next loop runs uninterrupted to its completion, then the final value of the loop control variable will be one step past the final value.  So, in your code (For i = 1 To 6), if PctYrlyIncrease is not less than ANY of the Tn values, then the loop will finish with i=7.  This is why we subtract 1 for iUseTier.

Now you just need to write functions for the other two ORType values :-)

Good luck!
Graham