Solved

IF statement vs Loops

Posted on 2014-03-14
28
217 Views
Last Modified: 2014-03-18
I need help putting the follow code in the correct sequence and order of events.

The needed order of events:
Data Sample:
sa

Step1:
Determine the OrType ( 1, 2, or 3)

If "ortype" = 1 then

Determine
if PctYrlyincrease = 0 then Return a value = 0

elseif PctYrlyincrease value is > Tier6 value.
If True then
[TotalNetUSExp] * rs1.Fields("T6E").Value

Elseif PctYrlincrease value is > Tier6 value = False then

Compare PctYrlyIncrease to each value in each of the remaining Tiers(1-5) to determine if the value PctYrlincrease > Tier(1) but PctYrlincrease < Tier2= True Then
Once the PctYrlyIncrease finds a tier Value that meets the criteria then return the value

       nOvrAmt = rs.Fields("TotalNetUSExp") * rs1.Fields(strfld).Value (T?E)  ? = the matching Tier?#
 

Step 2:

Move to next record and if the same contractNumber but different Quarter then retrieve the New PctYrlyIncrease value for the next quarter, then process the "IF" statements with new values for PctYrlyIncrease, Tier1-6 values.

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:
                End If
                If nfld > nTier6 Then
                    nOvrAmt = rs.Fields("TotalNetUSExp") * rs1.Fields("T6E").Value
                    BkOvrCalc = nOvrAmt
                    GoTo cont:
                End If
                If 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 = rs.Fields(nTierNo).Value
                            nfld2 = rs.Fields(strNextField).Value
                           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
                    nTr = nTr + 1
                    Next nTr
                End If
            Case 2 'Annual Flat%
            Case 3 'Annual Flat$
        End Select
cont:

        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

Open in new window

0
Comment
Question by:Karen Schaefer
  • 15
  • 8
  • 4
  • +1
28 Comments
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 39931167
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

Open 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

Open in new window

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

Expert Comment

by:Rgonzo1971
ID: 39931185
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

Open in new window

Regards
0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 39932794
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 & "'"

Open 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
0
 

Author Comment

by:Karen Schaefer
ID: 39934636
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:

pic
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

Open in new window

0
 

Author Comment

by:Karen Schaefer
ID: 39934668
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.
0
 

Author Comment

by:Karen Schaefer
ID: 39934721
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

Open in new window

0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 39934847
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?
0
 

Author Comment

by:Karen Schaefer
ID: 39934849
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
    

Open in new window

0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 39934870
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
0
 

Author Comment

by:Karen Schaefer
ID: 39934889
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
0
 

Author Comment

by:Karen Schaefer
ID: 39934968
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
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 39934969
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
0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 39935084
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
0
 

Author Comment

by:Karen Schaefer
ID: 39935108
Did you get the sample?  I posted about 1/2 hr ago.
0
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 

Author Comment

by:Karen Schaefer
ID: 39935310
Ok I create the Normalizing query per your suggestion, how should I proceed with the new data in the recommended format?
0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 39935334
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
0
 

Author Comment

by:Karen Schaefer
ID: 39935360
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));

Open in new window

0
 
LVL 47

Assisted Solution

by:Dale Fye (Access MVP)
Dale Fye (Access MVP) earned 100 total points
ID: 39935561
Karen,

That is really ugly, which explains why you should always normalize your data from the get-go.  Any time you are considering adding a number in the title of a column 'Q1T1', it is a good indication that you are poorly normalized.

The good news is that you could create a table with the correct format and then create a subroutine to populate it for you , something like
For intQtr = 1 to 4
For intTier = 1 to 6
strSQL = "INSERT INTO tbl_Contract_Qtr_Tier (ContractNumber, Qtr, Tier, TierAmt) " _
       & "SELECT [ContractNumber]" _
              & ", " & intQtr _
              & ", " & intTier _
              & ", [Q" & intQtr & "T" & intTier & "] " _
       & "FROM tblContracts " _
       & "WHERE  [Q" & intQtr & "T" & intTier & "] IS NOT NULL"
debug.print strsql
currentdb.execute strsql, dbfailonerror
next intTier
next intQtr

Open in new window

When that prints out the SQL string the first time, it should look like:

INSERT INTO tbl_Contract_Qtr_Tier (ContractNumber, Qtr, Tier, TierAmt)
SELECT [ContractNumber], 1, 1, [Q1T1]
FROM tblContracts
WHERE  [Q1T1] IS NOT NULL

Anything you do with the normalized data would run significantly quicker with a temporary table than with that ugly query you have above.

However, rather than confuse things, I'm going to sit back and let you and Graham work on his suggestions for a while. I find it gets confusing when there are too many chefs in the kitchen.  I'll continue to monitor so if you want me to chime back in, just say so.
0
 

Author Comment

by:Karen Schaefer
ID: 39935572
Dale, Thanks for the great input and your time.

Karen
0
 
LVL 20

Accepted Solution

by:
GrahamMandeno earned 400 total points
ID: 39935584
Hi Karen

I have taken a different approach and dispensed with the UNION query altogether (at least as far as the function is concerned.  Instead, I am building a SQL string containing only the QxTn fields for the given Quarter, and picking up these and the TnE fields directly from tblContracts.  I am passing PctYrlyIncrease (along with ContractNumber and Quarter) as arguments, and that way the function just needs to read a single record from the table, instead of using the very complex qrySummaryExpectation_Detail to recalculate the PctYrlyIncrease value.  The function returns the selected TnE value, and the multiplication is done in the query.

Here is my replacement code for the function:
Public Function BkOvrFactor( _
        ByVal ContractID As String, _
        ByVal Quarter As String, _
        ByVal PctYrlyIncrease As Double) _
    As Double
Dim curDB As DAO.Database
Dim sSQL 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 Quarters Totals for calculation of Override Dollars by Tier%
    sSQL = "SELECT ContractNumber, ORType"
    For i = 1 To 6
        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
                Next i
                iUseTier = i - 1
                If iUseTier = 0 Then
                  BkOvrFactor = 0
                Else
                  BkOvrFactor = rs("T" & iUseTier & "E")
                End If
            Case 2 'Annual Flat%
            Case 3 'Annual Flat$
        End Select
        Debug.Print ContractID, Quarter, PctYrlyIncrease, iUseTier, BkOvrFactor
    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

Open in new window

And here is the revised SQL for qryOverrideCalc:
SELECT qrySummaryExpectation_Detail.ContractNumber, 
	qrySummaryExpectation_Detail.Quarter, 
	qrySummaryExpectation_Detail.ORType, 
	qrySummaryExpectation_Detail.TotalNetUSExp, 
	qrySummaryExpectation_Detail.PctYrlyIncrease, 
	BkOvrFactor([qrySummaryExpectation_Detail].[ContractNumber],[qrySummaryExpectation_Detail].[Quarter],[PctYrlyIncrease]) AS OvrFactor, 
	CCur([TotalNetUSExp]*[OvrFactor]) AS OvrAmount, 
	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.ContractNumber = qryBkOverRide_Normalized.ContractNumber) 
	AND (qrySummaryExpectation_Detail.Quarter = qryBkOverRide_Normalized.Quarter);

Open in new window


Even with only 16 sample records it runs much faster!

Unless I have completely misunderstood (which is always a possibility :-)) the results look good.

Best wishes,
Graham
0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 39935612
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:
6 x ATnPer

6 x ATnDol

6 x TnE


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
0
 

Author Comment

by:Karen Schaefer
ID: 39935698
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
0
 

Author Comment

by:Karen Schaefer
ID: 39935701
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.
0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 39935822
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 :-)
0
 

Author Comment

by:Karen Schaefer
ID: 39937680
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

Open 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

Open 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.
0
 

Author Comment

by:Karen Schaefer
ID: 39938147
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

Open in new window

0
 

Author Closing Comment

by:Karen Schaefer
ID: 39938156
Most Excellent help,  Graham was a life saver,  Thank you so much for all your time and efforts.
0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 39938238
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
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now