Solved

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

Posted on 2014-03-13
5
224 Views
Last Modified: 2014-03-31
I am having several issues with looping thru a function that is be called from a Query.

Problem:

I  need to loop thru the contract numbers, each contract number can have up to 4 quarters' of data.

I need to compare the PctYrlyIncreas (Percentage) to each tier value for each quarter.

if the PctYrlyIncreas is less than any tier's value then the BkOvrAmt = 0

Else set the BovrAmt to the TotalNetUSExp * the tier value that is the first value that is greater than the PctYrlyIncrease value.

so I need to be able to Loop thru each tier until the value is greater than PctYrlyIncrease, then move on to the next record.
 
Please note that the "qryOverride_Calc" is already limited to specified contract and Quarter

SELECT qrySummaryExpectation_Detail.ContractNumber, qrySummaryExpectation_Detail.Quarter, qrySummaryExpectation_Detail.ORType, qrySummaryExpectation_Detail.TotalNetUSExp, qrySummaryExpectation_Detail.PctYrlyIncrease, 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);

See attached for sample of data.
sample
Here is my 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 strField As String, strNextField As String
Dim strfld As String, strfldNext As String
Dim nTr As Long
Dim nfld As String
Dim x As Integer, i As Integer
Dim nTierNo 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")
          Debug.Print "contractNo:" & gContractID
          Debug.Print "nfld: " & nfld
        Select Case x ' OverRide Type
            Case 1 'Quarters
               For nTr = 1 To 5
                   'determine which Quarter Tier value to use
                   nTierNo = "Tier" & nTr
                   Debug.Print nTierNo
                   strNextField = "Tier" & nTr + 1
                   Debug.Print strNextField
                   'Determine the % Payout:
                   strfld = "T" & nTr & "E"
                   strfldNext = "T" & nTr + 1 & "E"
          

                       If nfld < rs.Fields(nTierNo).Value Then
                           Debug.Print rs.Fields("TotalNetUSExp")
                           Debug.Print rs1.Fields(strfld).Value
                           nOvrAmt = 0
                           BkOvrCalc = nOvrAmt
                           GoTo cont:
                       ElseIf nfld > rs.Fields(nTierNo).Value And nfld < rs.Fields(strNextField).Value = True Then
                           nOvrAmt = rs.Fields("TotalNetUSExp") * rs1.Fields(strfld).Value
                           BkOvrCalc = nOvrAmt
                           GoTo cont:
                       End If
cont:
                nTr = nTr + 1
                Next nTr

            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

Open in new window


current code returns the following - The Tier values are not returning actual values:
Tier6
contractNo:00010674
nfld: 7.87772796174584E-02
Tier1
Tier2
Tier3
Tier4
Tier5
Tier6
contractNo:00010674
nfld: 0.514626110892186
Tier1
Tier2
Tier3
Tier4
Tier5
Tier6
contractNo:00010674
0
Comment
Question by:Karen Schaefer
  • 2
  • 2
5 Comments
 
LVL 20

Expert Comment

by:GrahamMandeno
Comment Utility
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]
0
 

Author Comment

by:Karen Schaefer
Comment Utility
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:

errmsg
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

Open in new window

0
 
LVL 20

Assisted Solution

by:GrahamMandeno
GrahamMandeno earned 250 total points
Comment Utility
Hi Karen

Your query with Tiers 1-6 in columns is not normalised.  A normalised structure would have each tier value in a separate row.

I'm having difficulty imagining where the TxEy values are coming from, and what purpose they serve.  Do you have a sample database you could upload?

-- Graham
0
 
LVL 47

Accepted Solution

by:
Dale Fye (Access MVP) earned 250 total points
Comment Utility
Karen,

Did you see the function I wrote in response to another one of your questions another one of your questions?

I think that function and the couple of lines of code I wrote in that response will resolve your issues.

Dale
0
 

Author Closing Comment

by:Karen Schaefer
Comment Utility
thanks guys
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.

771 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

10 Experts available now in Live!

Get 1:1 Help Now