Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Dim term, deflia, AmtRng, i, j, f1, f2, r1, r2, a1, a2, t1, ICPrem, FAmt As Double, rng1, rng2, rng3, rng4 As Range, BClass, kind, perf1, perf2, perf3, perf4 As String
- 'i - row number, j - column number, f1 - flat max, f2 - flat rate, r2 - Max % rate, r1 - % rate, a1,a2,t1 - temporary sums that lead to final premium computation, ICPrem - final proper premium for comparison to company premium, FAmt - Face amount of Bond, BClass - Bond Class, rng1,rng2,rng3,rng4 - range variables for the rates tables in the Ranges worksheet
- perf1 = "performance"
- perf2 = "infrastructure"
- perf3 = "surety"
- perf4 = "advance payment"
- For i = 10 To Rows.Count 'This line scans all data rows for computation
- If Cells(i, 9).Value <> "" Then 'Checks for face amount, if none line is skipped\
- FAmt = Cells(i, 9).Value
- BClass = Cells(i, 5).Value
- term = Cells(i, 8).Value
- kind = Cells(i, 3).Value
- Set Rng = Sheet4.Range("B49:E53")
- Set rng2 = Sheet4.Range("B4:G42")
- Set rng3 = Sheet4.Range("B4:B42")
- Set rng4 = Sheet4.Range("B3:G3")
- If FAmt > WorksheetFunction.VLookup(BClass, Rng, 3, False) Then 'This block checks if face amount is greater than flat max for its bond class, if it is then flat rates are used
- If BClass = "III" And FAmt > 300000 And InStr(1, kind, perf1, 1) <> 0 Then
- f1 = 0
- f2 = 0
- r1 = 0
- r2 = 0.55
- ElseIf BClass = "V" And FAmt > 500000 And (InStr(1, kind, perf3, 1) <> 0 Or InStr(1, kind, perf4, 1) <> 0) Then
- f1 = 0
- f2 = 0
- r1 = 0
- r2 = 0.6
- Else
- f1 = WorksheetFunction.VLookup(BClass, Rng, 3, False)
- f2 = WorksheetFunction.VLookup(BClass, Rng, 2, False)
- r1 = 0
- r2 = WorksheetFunction.VLookup(BClass, Rng, 4, False)
- End If
- Else 'If face amount if bond is within flat max of its bond class, the following block searches for appropriate rate from the rate table
- f1 = 0
- r2 = 0
- f2 = 0
- If FAmt > WorksheetFunction.Lookup(Cells(i, 9), rng3) Then
- AmtRng = (WorksheetFunction.Match(FAmt, rng3, 1)) + 1
- Select Case BClass
- Case Is = "I"
- r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
- Case Is = "II"
- r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
- Case Is = "III"
- r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
- Case Is = "IV"
- r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
- Case Is = "V"
- r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
- Case Else
- r1 = 0
- End Select
- Else
- Select Case BClass
- Case Is = "I"
- r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
- Case Is = "II"
- r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
- Case Is = "III"
- r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
- Case Is = "IV"
- r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
- Case Is = "V"
- r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
- Case Else
- r1 = 0
- End Select
- End If
- End If
- 'Below, the rates determined from above block are then used to compute for appropriate premium and results are printed to output worksheet
- a1 = (FAmt * r1) / 100
- t1 = FAmt - f1
- a2 = (t1 * r2) / 100
- ICPrem = ((a1 + a2 + f2) * term)
- If ICPrem < 500 * term Then
- ICPrem = (500 * term)
- End If
- deflia = ICPrem / term
- If InStr(1, kind, perf2, 1) <> 0 Then
- Sheet3.Cells(i, 15).Value = ICPrem + deflia
- Else
- Sheet3.Cells(i, 15).Value = ICPrem
- End If
- For j = 2 To 14
- Sheet3.Cells(i, j).Value = Cells(i, j)
- Next j
- Sheet3.Cells(i, 16).Value = Cells(i, 10).Value - Sheet3.Cells(i, 15).Value
- Sheet3.Cells(i, 17).Value = f1
- Sheet3.Cells(i, 18).Value = f2
- Sheet3.Cells(i, 19).Value = r1
- Sheet3.Cells(i, 20).Value = r2
- If ICPrem > Cells(i, 10) Then
- Sheet3.Cells(i, 10).Interior.ColorIndex = 48
- Else
- Sheet3.Cells(i, 10).Interior.ColorIndex = 46
- End If
- End If
- Next i
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement