totn Excel

MS Excel 2003: Function to calculate total cost based on a tiered fee structure

This Excel tutorial explains how to write a function to calculate the total cost based on a tiered fee structure in Excel 2003 and older versions (with screenshots and step-by-step instructions).

Question: In Excel 2003/XP/2000/97, I need a macro to calculate total cost based on a multi-tier fee structure.

For example,

On the first $500,000, a rate of 3.5% should be charged.
On the next $2,000,000, a rate of 2.5% should be charged.
On the next $2,500,000, a rate of 2% should be charged.
On the remainder, a rate of 1.5% should be charged.

How can I do this?

Answer: This can be accomplished with a VBA function.

Let's look at an example.

Download Excel spreadsheet (as demonstrated below)

Microsoft Excel

At the top of Sheet1, we've entered the fee structure amount and percentages (rows 3-7). Then we've created a function called CalcCost that accepts the fees as a parameter and returns the calculated cost based on those fees.

In our example, we're calculating the cost based on a fee amount of $13,800,00.

The function makes the following calculations:

On the first 500,000 x 3.5% $17,500
On the next 2,000,000 x 2.5% 50,000
On the next 2,500,000 x 2.0% 50,000
On the remainder 8,800,000 x 1.5% 132,000
Total   $249,500

The function then returns $249,500 as the result.

You can press Alt+F11 to view the VBA code.

Macro Code

The macro code looks like this:

Function CalcCost(pFees As Currency) As Currency

   Dim LTier1 As Currency
   Dim LTier2 As Currency
   Dim LTier3 As Currency

   Dim LTier1_perc As Single
   Dim LTier2_perc As Single
   Dim LTier3_perc As Single
   Dim LTier4_perc As Single

   'Determine tier 1 values
   LTier1 = Range("D4").Value
   LTier1_perc = (Range("F4").Value / 100)

   'Determine tier 2 values
   LTier2 = Range("D5").Value
   LTier2_perc = (Range("F5").Value / 100)

   'Determine tier 3 values
   LTier3 = Range("D6").Value
   LTier3_perc = (Range("F6").Value / 100)

   'Determine tier 4 values
   LTier4_perc = (Range("F7").Value / 100)

   'Falls within first tier
   If pFees <= LTier1 Then
      CalcCost = pFees * LTier1_perc

   'Falls within second tier
   ElseIf (pFees > LTier1) And (pFees <= LTier1 + LTier2) Then
      CalcCost = (LTier1 * LTier1_perc) + ((pFees - LTier1) * LTier2_perc)

   'Falls within third tier
   ElseIf (pFees > LTier1 + LTier2) And (pFees <= LTier1 + LTier2 + LTier3) Then
      CalcCost = (LTier1 * LTier1_perc) + (LTier2 * LTier2_perc) + ((pFees - (LTier1 + LTier2)) * LTier3_perc)

   'Exceeds third tier
   Else
      CalcCost = (LTier1 * LTier1_perc) + (LTier2 * LTier2_perc) + (LTier3 * LTier3_perc) + ((pFees - (LTier1 + LTier2 + LTier3)) * LTier4_perc)
   End If

End Function