How to create a tiered calculation

Posted on 2011-02-25
Last Modified: 2012-05-11
I 'm trying to create a function that will return of tiered amounts.  For example, I have the the following tier
Tier                                         %
0 to 2,500,000                         0
2,500,00.01 to 5,000,000        4%
5,000,000 to 10,000,000         6%
10,000,000.01 to 15,000,000  8%
>=15,000,000.01                      In addition to the 8% above, 20,000 for each million above 15,000,000

Basically, if the input value is 16,000,000.  I want take 0% of the first tier, add it to 4% of the second tier, add that result to 6% of the third tier and so on
Question by:chtullu135
LVL 92

Expert Comment

by:Patrick Matthews
ID: 34982398
>>In addition to the 8% above, 20,000 for each million above 15,000,000

What would the "bonus" amounts be for the following values:



Accepted Solution

JAMcDo earned 500 total points
ID: 34986189
Try this pair of functions.  It worked for me - assuming I interpreted your request properly.

Function TieredCalc(dblAmt As Double) As Double

    Dim dblPercentAmt As Double
        dblPercentAmt = 0
        If dblAmt > 2500000 Then   'Calculate first tiered amount
            dblPercentAmt = (MinOf2(dblAmt, 5000000) - 2500000) * 0.04
        End If
        If dblAmt > 5000000 Then  'Calculate 2nd tiered amount + 1st tiered amount
            dblPercentAmt = dblPercentAmt + (MinOf2(dblAmt, 10000000) - 5000000) * 0.06
        End If
        If dblAmt > 10000000 Then                        'Calculate 3rd tiered amount + first 2 tiered amounts
            dblPercentAmt = dblPercentAmt + (dblAmt - 10000000) * 0.08
        End If
        If dblAmt > 15000000 Then                       'Calculate 20000 per million over 15 million
            dblPercentAmt = dblPercentAmt + Int((dblAmt - 15000000) / 1000000) * 20000
        End If
        TieredCalc = dblPercentAmt
End Function

Function MinOf2(dblFirst As Double, dblSecond As Double) As Double

    If dblFirst < dblSecond Then
        MinOf2 = dblFirst
        MinOf2 = dblSecond
    End If
End Function

LVL 44

Expert Comment

ID: 34989703
I like that.  Well done John!
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.


Author Comment

ID: 34997399
The bonus amounts would be

Author Comment

ID: 34997408
The bonus amounts would be
Amount                      Bonus Amt
15,999,999.99                0
16,000,000.00             20,000
16,000,000.01             20,000
16,500,000.00             20,000
16,999,999.99             20,000
17,000,000                  40,000

Author Closing Comment

ID: 34997622
Thanks for the help.  I did come up with the following solution which also works but yours is much cleaner so I will use the one you came up with

Private Function GetESP(dblTotalPayment As Double) As Double
Dim dblIncentiveAmount As Double
Dim dblESP As Double

dblIncentiveAmount = dblTotalPayment
Dim dblTier1 As Double
Dim dblTier2 As Double
Dim dblTier3 As Double
Dim dblTier4 As Double
Dim dblTier5 As Double
Dim dblTotal As Double

dblTier1 = 0

If dblIncentiveAmount <= 2500000 Then
        dblTier1 = 0
End If

If dblIncentiveAmount > 5000000 Then
        dblTier2 = ((2500000) * 0.04)
End If

If dblIncentiveAmount > 10000000 Then
        dblTier3 = ((10000000 - 5000000.01) * 0.06)
End If

If dblIncentiveAmount > 15000000 Then
        dblTier4 = ((15000000 - 10000000.01) * 0.08)
End If

If dblIncentiveAmount > 16000000 Then

        dblTier5 = ((dblIncentiveAmount - 15000000.01) * 0.08) + (Int(((dblIncentiveAmount - conMaximumIA) / 1000000)) * conOverAmt)
End If

dblTotal = dblTier1 + dblTier2 + dblTier3 + dblTier4 + dblTier5

GetESP = dblTotal

End Function

Featured Post

Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
Preparing an email is something we should all take special care with – especially when the email is for somebody you may not know very well. The pressures of everyday working life stacked with a hectic office environment can make this a real challen…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…

777 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