Advertisement
BennY_T

Excel Code Sample

Feb 20th, 2020
1,269
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.25 KB | None | 0 0
  1. 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
  2. '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
  3. perf1 = "performance"
  4. perf2 = "infrastructure"
  5. perf3 = "surety"
  6. perf4 = "advance payment"
  7. For i = 10 To Rows.Count 'This line scans all data rows for computation
  8. If Cells(i, 9).Value <> "" Then 'Checks for face amount, if none line is skipped\
  9. FAmt = Cells(i, 9).Value
  10. BClass = Cells(i, 5).Value
  11. term = Cells(i, 8).Value
  12. kind = Cells(i, 3).Value
  13. Set Rng = Sheet4.Range("B49:E53")
  14. Set rng2 = Sheet4.Range("B4:G42")
  15. Set rng3 = Sheet4.Range("B4:B42")
  16. Set rng4 = Sheet4.Range("B3:G3")
  17. 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
  18. If BClass = "III" And FAmt > 300000 And InStr(1, kind, perf1, 1) <> 0 Then
  19. f1 = 0
  20. f2 = 0
  21. r1 = 0
  22. r2 = 0.55
  23. ElseIf BClass = "V" And FAmt > 500000 And (InStr(1, kind, perf3, 1) <> 0 Or InStr(1, kind, perf4, 1) <> 0) Then
  24. f1 = 0
  25. f2 = 0
  26. r1 = 0
  27. r2 = 0.6
  28. Else
  29. f1 = WorksheetFunction.VLookup(BClass, Rng, 3, False)
  30. f2 = WorksheetFunction.VLookup(BClass, Rng, 2, False)
  31. r1 = 0
  32. r2 = WorksheetFunction.VLookup(BClass, Rng, 4, False)
  33. End If
  34. 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
  35. f1 = 0
  36. r2 = 0
  37. f2 = 0
  38. If FAmt > WorksheetFunction.Lookup(Cells(i, 9), rng3) Then
  39. AmtRng = (WorksheetFunction.Match(FAmt, rng3, 1)) + 1
  40. Select Case BClass
  41. Case Is = "I"
  42. r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
  43. Case Is = "II"
  44. r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
  45. Case Is = "III"
  46. r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
  47. Case Is = "IV"
  48. r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
  49. Case Is = "V"
  50. r1 = WorksheetFunction.Index(rng2, AmtRng, WorksheetFunction.Match(BClass, rng4, 0))
  51. Case Else
  52. r1 = 0
  53. End Select
  54. Else
  55. Select Case BClass
  56. Case Is = "I"
  57. r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
  58. Case Is = "II"
  59. r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
  60. Case Is = "III"
  61. r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
  62. Case Is = "IV"
  63. r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
  64. Case Is = "V"
  65. r1 = WorksheetFunction.Index(rng2, WorksheetFunction.Match(FAmt, rng3, 1), WorksheetFunction.Match(BClass, rng4, 0))
  66. Case Else
  67. r1 = 0
  68. End Select
  69. End If
  70. End If
  71. 'Below, the rates determined from above block are then used to compute for appropriate premium and results are printed to output worksheet
  72. a1 = (FAmt * r1) / 100
  73. t1 = FAmt - f1
  74. a2 = (t1 * r2) / 100
  75. ICPrem = ((a1 + a2 + f2) * term)
  76. If ICPrem < 500 * term Then
  77. ICPrem = (500 * term)
  78. End If
  79. deflia = ICPrem / term
  80. If InStr(1, kind, perf2, 1) <> 0 Then
  81. Sheet3.Cells(i, 15).Value = ICPrem + deflia
  82. Else
  83. Sheet3.Cells(i, 15).Value = ICPrem
  84. End If
  85. For j = 2 To 14
  86. Sheet3.Cells(i, j).Value = Cells(i, j)
  87. Next j
  88. Sheet3.Cells(i, 16).Value = Cells(i, 10).Value - Sheet3.Cells(i, 15).Value
  89. Sheet3.Cells(i, 17).Value = f1
  90. Sheet3.Cells(i, 18).Value = f2
  91. Sheet3.Cells(i, 19).Value = r1
  92. Sheet3.Cells(i, 20).Value = r2
  93. If ICPrem > Cells(i, 10) Then
  94. Sheet3.Cells(i, 10).Interior.ColorIndex = 48
  95. Else
  96. Sheet3.Cells(i, 10).Interior.ColorIndex = 46
  97. End If
  98. End If
  99. Next i
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement