Bond

Rumpkin

Board Regular
Joined
Sep 24, 2016
Messages
75
Office Version
  1. 2019
Platform
  1. Windows
This works in excel 97 -2003 but does not work in 2013 or 2016.
I get a the #Name ? value.
Will you review and see what needs to change to work in 2013 or newer?

Code:
Function BOND(Subtotal, TaxRate) As Single
                            'Author Jim Hesh
                            'Set limits and rates according to your company's bond structure
  Dim Limit(6) As Single    'Increase this value for more limit steps
  Dim BondRate(6) As Single
  Dim B1 As Single
  Dim B2 As Single
  Dim i As Integer
  Dim Basis As Single
  Dim TempTotal As Single
  
  Limit(0) = 0
  Limit(1) = 100000      '   $400,000
  Limit(2) = 400000      '   $500,000
  Limit(3) = 1000000     '   $1,000,000
  Limit(4) = 2000000     '   $2,000,000
  Limit(5) = 2500000     '   $2,500,000
  Limit(6) = 2500001     '   $2,000,001
  BondRate(0) = 0
  BondRate(1) = 0.025    ' $25.00 per thousand Up to limit(1)
  BondRate(2) = 0.015    ' $15.00 per thousand From limit(2) to Limit(3)
  BondRate(3) = 0.01     ' $10.00 per thousand From limit(3) to Limit(4)
  BondRate(4) = 0.0075   ' $7.50 per thousand From limit(4) to Limit(5)
  BondRate(5) = 0.007    ' $7.00 per thousand From limit(4) to Limit(5)
  BondRate(6) = 0.0065   ' $6.50 per thousand From limit(4) to Limit(5)
  B1 = 0
  i = 0
  While Subtotal > Limit(i + 1)
    i = i + 1
    B1 = B1 + (Limit(i) - Limit(i - 1)) * BondRate(i)
  Wend
  
  Basis = (Subtotal * (1 + TaxRate) - Limit(i) + B1) / (1 - BondRate(i + 1) * (1 + TaxRate))
  'Round up to a full thousand
  Basis = 1000 * Int(Basis / 1000 + 0.999)
  B2 = BondRate(i + 1) * Basis
  TempTotal = B2 + Subtotal * (TaxRate + 1)

  'Check to see if tax + bond increase total to over the next limit
  If TempTotal > Limit(i + 1) Then
    i = i + 1
    B1 = B1 + (Limit(i) - Limit(i - 1)) * BondRate(i)
    Basis = Basis - Limit(i) + Limit(i - 1)
    Basis = 1000 * Int(Basis / 1000 + 0.999)
   End If
  B2 = BondRate(i + 1) * Basis
  BOND = B2 + B1
End Function
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
I do not get any error. Perhaps you copied the function into a worksheet object instead of a "normal" module.

Delete what you have, wherever it is.

In VBA, click Insert > Module, and copy-and-paste the function text into the editing pane.

You will need to save the file as "xls" or "xlsm" in order to save the function in the Excel workbook.

Aside.... Change all "Single" to "Double". Change all "Integer" to "Long".

The intent of Int(Basis / 1000 + 0.999) is to "round up to a full thousand". But adding 0.999 is not guaranteed to do that, even with type Single.

I suggest that you replace that with WorksheetFunction.RoundUp(Basis/1000,0) in two places.

I am not bothering to try to understand what the function does. But you might look at the Excel financial functions to see if you could use one of them instead.
 
Last edited:
Upvote 0
I am not bothering to try to understand what the function does. But you might look at the Excel financial functions to see if you could use one of them instead.

Okay, I looked at the function briefly, and obviously no Excel function does exactly the same thing. But you still might be able to do the same thing in Excel with a little effort.
 
Upvote 0
Thanks.
Solution was to name all the Single to Double
Insert a new module copy code, delete the old module which I had named BOND.
I confirmed both ways and for the code to work the module cannot be re-named
The code is for calculating performance payment bond fees for construction work.
The cost of bond is the sum of the bid + tax + bond plus tax on the total so it's circular.
Thanks again, Have a wonderful Christmas
 
Upvote 0
Here is the working code. FYI
Code:
Private Function Bond(SubTotal, TaxRate As Double) As Double
  ' This function computes BOND as a function of the job subtotal, i.e., all values
  ' included except tax and bond, and the tax rate.
  ' If additional steps are required, the user should
  ' also modify:
  ' * The DIM statement arrays
  ' * The additional values for Rate() and Limit()
  ' * The upper limit of the FOR loop
  ' * Additional values for "i"
  Dim Rate(6) As Double
  Dim Limit(6) As Double
  Dim Fixed(6) As Double
  Dim i As Byte

  Rate(1) = 0.025
  Rate(2) = 0.015
  Rate(3) = 0.01
  Rate(4) = 0.0075
  Rate(5) = 0.007
  Rate(6) = 0.0065
  
  Limit(0) = 0
  Limit(1) = 100000
  Limit(2) = 400000
  Limit(3) = 1000000
  Limit(4) = 2000000
  Limit(5) = 2500000
  Limit(6) = 2500001

  Fixed(0) = 0

  For i = 1 To 6
    Fixed(i) = Fixed(i - 1) + Rate(i) * (Limit(i) - Limit(i - 1))
  Next i
  
  If SubTotal < Limit(1) Then
      i = 1
    ElseIf SubTotal < Limit(2) Then
      i = 2
    ElseIf SubTotal < Limit(3) Then
      i = 3
    ElseIf SubTotal < Limit(4) Then
      i = 4
    ElseIf SubTotal < Limit(5) Then
      i = 5
    ElseIf SubTotal < Limit(6) Then
      i = 6
  End If

  Bond = (Fixed(i - 1) + Rate(i) * (SubTotal * (1 + TaxRate) - Limit(i - 1))) / (1 - Rate(i) * (1 + TaxRate))

  If ((SubTotal + Bond) * (1 + TaxRate)) > Limit(i) Then
        i = i + 1
    Bond = (Fixed(i - 1) + Rate(i) * (SubTotal * (1 + TaxRate) - Limit(i - 1))) / (1 - Rate(i) * (1 + TaxRate))
  End If
  Bond = Fixed(i - 1) + 1000 * Rate(i) * Int((Bond - Fixed(i - 1)) / (1000 * Rate(i)) + 0.999)
End Function
 
Upvote 0
The intent of Int(Basis / 1000 + 0.999) is to "round up to a full thousand". [....] I suggest that you replace that with WorksheetFunction.RoundUp(Basis/1000,0) in two places.

Frankly, I did not really read the code carefully. I was just reacting to the poor practice of adding a fixed fractional number (0.999) in order to accomplish some form of rounding.

The more reliable way to round up to a multiple of 1000 is WorksheetFunction.RoundUp(Basis,-3) .
 
Upvote 0
Here is the working code. FYI
Code:
Private Function Bond(SubTotal, TaxRate As Double) As Double
  ' This function computes BOND as a function of the job subtotal, i.e., all values
  ' included except tax and bond, and the tax rate.
  ' If additional steps are required, the user should
  ' also modify:
  ' * The DIM statement arrays
  ' * The additional values for Rate() and Limit()
  ' * The upper limit of the FOR loop
  ' * Additional values for "i"
  Dim Rate(6) As Double
  Dim Limit(6) As Double
  Dim Fixed(6) As Double
  Dim i As Byte

  Rate(1) = 0.025
  Rate(2) = 0.015
  Rate(3) = 0.01
  Rate(4) = 0.0075
  Rate(5) = 0.007
  Rate(6) = 0.0065
 
  Limit(0) = 0
  Limit(1) = 100000
  Limit(2) = 400000
  Limit(3) = 1000000
  Limit(4) = 2000000
  Limit(5) = 2500000
  Limit(6) = 2500001

  Fixed(0) = 0

  For i = 1 To 6
    Fixed(i) = Fixed(i - 1) + Rate(i) * (Limit(i) - Limit(i - 1))
  Next i
 
  If SubTotal < Limit(1) Then
      i = 1
    ElseIf SubTotal < Limit(2) Then
      i = 2
    ElseIf SubTotal < Limit(3) Then
      i = 3
    ElseIf SubTotal < Limit(4) Then
      i = 4
    ElseIf SubTotal < Limit(5) Then
      i = 5
    ElseIf SubTotal < Limit(6) Then
      i = 6
  End If

  Bond = (Fixed(i - 1) + Rate(i) * (SubTotal * (1 + TaxRate) - Limit(i - 1))) / (1 - Rate(i) * (1 + TaxRate))

  If ((SubTotal + Bond) * (1 + TaxRate)) > Limit(i) Then
        i = i + 1
    Bond = (Fixed(i - 1) + Rate(i) * (SubTotal * (1 + TaxRate) - Limit(i - 1))) / (1 - Rate(i) * (1 + TaxRate))
  End If
  Bond = Fixed(i - 1) + 1000 * Rate(i) * Int((Bond - Fixed(i - 1)) / (1000 * Rate(i)) + 0.999)
End Function
How do you use this code? I found while looking for a way to calculate P&P bonds within excel for bidding purposes.
 
Upvote 0
Yeah, wrote this back in 1998 to be able to figure the correct bond fees since it is a circular calculation.
Question. Did you find another way to do the calculation?
 
Upvote 0
Can you post an example with XL2BB?
Is this a tiered formula?
What is the result for a few examples?
Result for 2,500,000?

With just a quick read of the information and a guess of your requirements,
SumProduct, Sum, or Lambda Bond may provide the answer without VBA.

Do you need a formula for earlier versions or just 365?
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,248
Members
452,623
Latest member
cliftonhandyman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top