Option Explicit
Dim valueAmtD As Double
Dim valueAmtDT As Double
Dim NoUD As Double
Dim NoUDT As Double
Dim SID As Double
Dim SIDT As Double
Dim SD As String
Dim sDT As String
Dim valueCellD As String
Dim valueCellDT As String
Dim sheetA As String
Dim sheetB As String
Dim sheetC As String
Dim sheetD As String
Dim rangeDT As String
Dim rangeSIDT As String
Dim rangeNoUDT As String
Dim rangeD As String
Dim rangeSID As String
Dim rangeNoUD As String
Dim maxben As Double
Dim MaxSal As Double
Dim stampD As Double 'Stamp Duty
'Populates drop downs etc when the main form is opened.
Private Sub UserForm_Initialize()
Dim hit As Integer
hit = ActiveWindow.UsableHeight
If hit < 490 Then
ufCombIns.Zoom = 89
ufCombIns.Width = 594
Else:
ufCombIns.Zoom = 100
tbxDisDis.Visible = False
End If
cbxAge.RowSource = "DTArrays!A21:A72"
cbxNoH.RowSource = "DTArrays!A4:A171"
cbxSex.List = Array("Female", "Male")
cbxState.List = Array("Qld", "NSW", "ACT", "Vic", "Tas", "SA",
"WA", "NT")
cbxOcCat.List = Array("White Collar", "Light Blue Collar", "Heavy
Blue Collar", "Individual Consideration", "Not Available")
tbxDis = Range("Admin!B30")
tbxDisDis = Range("Admin!B30")
cbxASM.RowSource = "Admin!A35:A44"
cbxZoom.List = Array("Laptop", "100%", "95%", "90%", "85%", "80%",
"75%", "70%", "60%")
cbxSex.Locked = True
cbxState.Locked = True
cbxNoH.Locked = True
cbxNoUDO.Locked = True
cbxNoUDT.Locked = True
cbxSIDO.Locked = True
cbxSIDT.Locked = True
cbxOcCat.Locked = True
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End Sub
Private Sub cbxSex_Change()
'When changing SEX clears these frames.(yes very funny...hehe)
'Income Protection
tbxWkBenN = ""
tbxWkBenS = ""
tbxWkBenT = ""
tbxAnPrem = ""
tbxWkPrem = ""
tbxAnPremSD = ""
tbxWkPremSD = ""
tbxNoUIP = ""
tbxEligible = ""
'Death Only and Death & TPD
cbxNoUDO = ""
cbxNoUDT = ""
cbxSIDO = ""
cbxSIDT = ""
tbxDOAnPrem = ""
tbxDOWkPrem = ""
tbxDTAnPrem = ""
tbxDTWkPrem = ""
'tbxUValDO = ""
'tbxUValDT = ""
'tbxTPDDef = ""
'Total
tbxSumAnPrem = ""
tbxSumAnPrem = ""
'If cbxSex = "" Then
'cbxState.Locked = True
'End If
If cbxSex <> "" Then
cbxState.Locked = False
End If
End Sub
Private Sub cbxState_Change()
'When changing STATE clears these frames.
'Income Protection
tbxWkBenN = ""
tbxWkBenS = ""
tbxWkBenT = ""
tbxAnPrem = ""
tbxWkPrem = ""
tbxAnPremSD = ""
tbxWkPremSD = ""
tbxNoUIP = ""
tbxEligible = ""
'Death Only and Death & TPD
cbxNoUDO = ""
cbxNoUDT = ""
cbxSIDO = ""
cbxSIDT = ""
tbxDOAnPrem = ""
tbxDOWkPrem = ""
tbxDTAnPrem = ""
tbxDTWkPrem = ""
'tbxUValDO = ""
'tbxUValDT = ""
'tbxTPDDef = ""
'Total
tbxSumAnPrem = ""
tbxSumAnPrem = ""
'tickDO = False
'tickDT = False
'tickIP = False
If cbxState <> "" Then
cbxNoH.Locked = False
cbxNoUDO.Locked = False
cbxNoUDT.Locked = False
cbxSIDO.Locked = False
cbxSIDT.Locked = False
tbxSal.Locked = False
tickIP.Locked = False
tickDO.Locked = False
tickDT.Locked = False
End If
End Sub
Private Sub cmdClearIP_Click()
'Clear all fields in the income protection frame.
tbxWkBenN = ""
tbxWkBenS = ""
tbxWkBenT = ""
tbxAnPrem = ""
tbxWkPrem = ""
tbxAnPremSD = ""
tbxWkPremSD = ""
tbxNoUIP = ""
tbxEligible = ""
tbxSal = ""
tbxOcCat = ""
cbxOcCat = ""
'tickIP = False
If cbxAge = "" Then
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End If
If cbxSex = "" Then
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End If
If cbxState = "" Then
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End If
If cbxNoH = "" Then
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End If
End Sub
Private Sub cmdClearD_Click()
' Clear all fields in the Death/Death&TPD frame.
cbxNoUDO = ""
cbxNoUDT = ""
cbxSIDO = ""
cbxSIDT = ""
tbxDOAnPrem = ""
tbxDOWkPrem = ""
tbxDTAnPrem = ""
tbxDTWkPrem = ""
tbxUValDO = ""
tbxUValDT = ""
tbxTPDDef = ""
tickDO = False
tickDT = False
If cbxAge = "" Then
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End If
If cbxSex = "" Then
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End If
If cbxState = "" Then
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End If
If cbxNoH = "" Then
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End If
End Sub
Private Sub cmdClearUF_Click()
'Clear all fields on the form.
'Shared fields
cbxAge = ""
cbxSex = ""
cbxState = ""
cbxNoH = ""
'Income Protection
tbxOcCat = ""
cbxOcCat = ""
tbxSal = ""
tbxWkBenN = ""
tbxWkBenS = ""
tbxWkBenT = ""
tbxAnPrem = ""
tbxWkPrem = ""
tbxAnPremSD = ""
tbxWkPremSD = ""
tbxNoUIP = ""
tbxEligible = ""
'cbxOcCat.Locked = False
'tbxSal.Locked = False
'Death/TPD Frame
'cbxNoUDT.Locked = False
'cbxSIDT.Locked = False
cbxNoUDO = ""
cbxNoUDT = ""
cbxSIDO = ""
cbxSIDT = ""
tbxDOAnPrem = ""
tbxDOWkPrem = ""
tbxDTAnPrem = ""
tbxDTWkPrem = ""
tbxUValDO = ""
tbxUValDT = ""
tbxTPDDef = ""
tbxSumAnPrem = ""
tbxSumWkPrem = ""
tickDO = False
tickDT = False
tickIP = False
cbxSex.Locked = True
cbxState.Locked = True
cbxNoH.Locked = True
cbxNoUDO.Locked = True
cbxNoUDT.Locked = True
cbxSIDO.Locked = True
cbxSIDT.Locked = True
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End Sub
Private Sub cmdLookUp_Click()
'Click the "Look Up Occupation" command button
'and open a form that has a list box populated from a range on
a woorksheet.
Dim myForm2 As ufOcCat
Set myForm2 = New ufOcCat
myForm2.Show
Set myForm2 = Nothing
End Sub
Private Sub cbxAge_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
'do nothing
Case Else
Beep
KeyAscii = 0
End Select
End Sub
Private Sub cbxNoH_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
'do nothing
Case Else
Beep
KeyAscii = 0
End Select
End Sub
Private Sub cbxNoUDT_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
'do nothing
Case Else
Beep
KeyAscii = 0
End Select
End Sub
Private Sub cbxNoUDO_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
'do nothing
Case Else
Beep
KeyAscii = 0
End Select
End Sub
Private Sub cbxSIDT_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
'do nothing
Case Else
Beep
KeyAscii = 0
End Select
End Sub
Private Sub cbxSIDO_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
'do nothing
Case Else
Beep
KeyAscii = 0
End Select
End Sub
Private Sub cbxAge_Change()
'Unlocks these boxes
'When changing age clears these frames.
cbxSex = ""
cbxState = ""
cbxNoH = ""
'Income Protection
cbxOcCat = ""
tbxSal = ""
tbxWkBenN = ""
tbxWkBenS = ""
tbxWkBenT = ""
tbxAnPrem = ""
tbxWkPrem = ""
tbxAnPremSD = ""
tbxWkPremSD = ""
tbxNoUIP = ""
tbxEligible = ""
'Death Only And Death & TPD
cbxNoUDO = ""
cbxNoUDT = ""
cbxSIDO = ""
cbxSIDT = ""
tbxDOAnPrem = ""
tbxDOWkPrem = ""
tbxDTAnPrem = ""
tbxDTWkPrem = ""
tbxUValDO = ""
tbxUValDT = ""
tbxTPDDef = ""
If cbxAge <> "" Then
cbxSex.Locked = False
cbxState.Locked = True
cbxNoUDO.Locked = True
cbxNoUDT.Locked = True
cbxSIDO.Locked = True
cbxSIDT.Locked = True
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
End If
If (cbxAge < 18) Then
tbxEligible = "Insurance is not available to members uner 18 years
of age."
cbxSex.Locked = True
cbxState.Locked = True
cbxNoUDO.Locked = True
cbxNoUDT.Locked = True
cbxSIDO.Locked = True
cbxSIDT.Locked = True
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
GoTo Label2
If (cbxAge < 65) Then
If cbxNoH <> "" Then
'cbxNoH.Locked = False
cbxNoUDT.Locked = False
cbxSIDT.Locked = False
cbxOcCat.Locked = False
tbxSal.Locked = False
End If
End If
If (cbxAge > 69) Then
tbxEligible = "Insurance is not available to members over 69 years
of age."
cbxNoUDO = "NA"
cbxSIDO = "NA"
cbxNoUDT = "NA"
cbxSIDT = "NA"
tbxSal = "NA"
tickIP = False
tickDT = False
tickDO = False
cbxSex.Locked = True
cbxState.Locked = True
cbxNoUDO.Locked = True
cbxSIDO.Locked = True
cbxNoUDT.Locked = True
cbxSIDT.Locked = True
tbxSal.Locked = True
cbxOcCat.Locked = True
cmdLookUp.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
GoTo Label2
End If
End If
'If over 65 shows that Death&TPD and IP not available.
If (cbxAge > 64) Then
cbxNoUDT = "NA"
cbxSIDT = "NA"
tbxDTAnPrem = "NA"
tbxDTWkPrem = "NA"
tbxUValDT = "NA"
tbxTPDDef = "Death & TPD Insurance not available to persons
65 or over."
cbxOcCat = "NA"
tbxSal = "NA"
tbxWkBenN = "NA"
tbxWkBenS = "NA"
tbxWkBenT = "NA"
tbxAnPrem = "NA"
tbxWkPrem = "NA"
tbxAnPremSD = "NA"
tbxWkPremSD = "NA"
tbxNoUIP = "NA"
tbxEligible = "Income Protection Insurance not available to
persons 65 or over"
cbxNoH.Locked = True
cbxNoUDT.Locked = True
cbxSIDT.Locked = True
cbxOcCat.Locked = True
tbxSal.Locked = True
End If
'If AGE changed this finds relevant cells for Sum Insured, Unit Value
for age.
If cbxAge <> "" Then
sheetA = "=DTArrays!"
sheetB = "DTArrays"
Select Case cbxAge
Case Is <= 29
valueCellDT = "B"
Case Is <= 34
valueCellDT = "C"
Case Is <= 39
valueCellDT = "D"
Case Is <= 44
valueCellDT = "E"
Case Is <= 49
valueCellDT = "F"
Case Is <= 54
valueCellDT = "G"
Case Is <= 59
valueCellDT = "H"
Case Is <= 64
valueCellDT = "I"
Case Else
GoTo Label1
End Select
NoUDT = 0
SIDT = 0
rangeDT = valueCellDT & "3"
Do Until SIDT > 1000001
NoUDT = NoUDT + 1
SIDT = NoUDT * Worksheets(sheetB).Range(rangeDT).Value
Loop
NoUDT = NoUDT + 2
sDT = NoUDT
rangeSIDT = valueCellDT & "4:" & valueCellDT & sDT
rangeNoUDT = "A4:" & valueCellDT & sDT
cbxSIDT.RowSource = sheetA & rangeSIDT
cbxNoUDT.RowSource = sheetA & rangeNoUDT
valueAmtDT =
FormatCurrency((Worksheets(sheetB).Range(rangeDT).Value), 0)
tbxUValDT = FormatCurrency((valueAmtDT), 0)
Label1:
sheetC = "=DArrays!"
sheetD = "DArrays"
Select Case cbxAge
Case Is <= 29
valueCellD = "B"
Case Is <= 34
valueCellD = "C"
Case Is <= 39
valueCellD = "D"
Case Is <= 44
valueCellD = "E"
Case Is <= 49
valueCellD = "F"
Case Is <= 54
valueCellD = "G"
Case Is <= 59
valueCellD = "H"
Case Is <= 64
valueCellD = "I"
Case Else
valueCellD = "J"
End Select
NoUD = 0
SID = 0
rangeD = valueCellD & "3"
Do Until SID > 1000001
NoUD = NoUD + 1
SID = NoUD * Worksheets(sheetD).Range(rangeD).Value
Loop
NoUD = NoUD + 2
SD = NoUD
rangeSID = valueCellD & "4:" & valueCellD & SD
rangeNoUD = "A4:" & valueCellD & SD
cbxSIDO.RowSource = sheetC & rangeSID
cbxNoUDO.RowSource = sheetC & rangeNoUD
valueAmtD =
FormatCurrency((Worksheets(sheetD).Range(rangeD).Value), 0)
tbxUValDO = FormatCurrency((valueAmtD), 0)
End If
Label2:
End Sub
Private Sub cbxSIDO_Change()
'Calcs premium and recalcs relevant totals if DEATH ONLY SUM INSURED
AMOUNT changed.
If cbxSIDO <> "" Then
cbxNoUDO = cbxSIDO / valueAmtD
tbxDOAnPrem = FormatCurrency((((cbxNoUDO *
ufAdmin.tbxAdminDOPrem.Value) * 52)), 0)
tbxDOWkPrem = FormatCurrency((cbxNoUDO *
ufAdmin.tbxAdminDOPrem.Value), 0)
Dim VtbxDTAnPrem As Double
Dim VtbxAnPremSD As Double
Dim VtbxDTWkPrem As Double
Dim VtbxWkPremSD As Double
Dim VtbxDOAnPrem As Double
Dim VtbxDOWkPrem As Double
If IsNumeric(tbxDOAnPrem) = True Then
VtbxDOAnPrem = tbxDOAnPrem
Else: VtbxDOAnPrem = 0
End If
If IsNumeric(tbxDOWkPrem) = True Then
VtbxDOWkPrem = tbxDOWkPrem
Else: VtbxDOWkPrem = 0
End If
If IsNumeric(tbxDTAnPrem) = True Then
VtbxDTAnPrem = tbxDTAnPrem
Else: VtbxDTAnPrem = 0
End If
If IsNumeric(tbxDTWkPrem) = True Then
VtbxDTWkPrem = tbxDTWkPrem
Else: VtbxDTWkPrem = 0
End If
If IsNumeric(tbxWkPremSD) = True Then
VtbxWkPremSD = tbxWkPremSD
Else: VtbxWkPremSD = 0
End If
If IsNumeric(tbxAnPremSD) = True Then
VtbxAnPremSD = tbxAnPremSD
Else: VtbxAnPremSD = 0
End If
If tickDT = True Then tickDO = False
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
If tickDT = False Then
If tickDO = False Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = ""
tbxSumWkPrem = ""
End If
End If
If tickDT = False Then
If tickDO = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem), 2)
End If
End If
End If
'If tickDO = True Then tickDT = False
' If tickIP = True Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem + VtbxAnPremSD), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem + VtbxWkPremSD), 2)
' If tickIP = False Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem), 2)
If tickDO = False Then
If tickDT = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
End If
End If
End If
labelF:
If tickDT = True Then tickDO = False
End If
If cbxSIDO = "" Then
cbxNoUDO = ""
tbxDOAnPrem = ""
tbxDOWkPrem = ""
End If
End Sub
Private Sub cbxNoUDO_Change()
'Calcs premium and recalcs relevant totals if NO OF UNITS OF DEATH ONLY
changed.
If cbxNoUDO <> "" Then
cbxSIDO = FormatCurrency((cbxNoUDO * valueAmtD), 0)
tbxDOAnPrem = FormatCurrency((((cbxNoUDO *
ufAdmin.tbxAdminDOPrem.Value) * 52)), 0)
tbxDOWkPrem = FormatCurrency((cbxNoUDO *
ufAdmin.tbxAdminDOPrem.Value), 0)
Dim VtbxDTAnPrem As Double
Dim VtbxAnPremSD As Double
Dim VtbxDTWkPrem As Double
Dim VtbxWkPremSD As Double
Dim VtbxDOAnPrem As Double
Dim VtbxDOWkPrem As Double
If IsNumeric(tbxDOAnPrem) = True Then
VtbxDOAnPrem = tbxDOAnPrem
Else: VtbxDOAnPrem = 0
End If
If IsNumeric(tbxDOWkPrem) = True Then
VtbxDOWkPrem = tbxDOWkPrem
Else: VtbxDOWkPrem = 0
End If
If IsNumeric(tbxDTAnPrem) = True Then
VtbxDTAnPrem = tbxDTAnPrem
Else: VtbxDTAnPrem = 0
End If
If IsNumeric(tbxDTWkPrem) = True Then
VtbxDTWkPrem = tbxDTWkPrem
Else: VtbxDTWkPrem = 0
End If
If IsNumeric(tbxWkPremSD) = True Then
VtbxWkPremSD = tbxWkPremSD
Else: VtbxWkPremSD = 0
End If
If IsNumeric(tbxAnPremSD) = True Then
VtbxAnPremSD = tbxAnPremSD
Else: VtbxAnPremSD = 0
End If
If tickDT = True Then tickDO = False
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
If tickDT = False Then
If tickDO = False Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = ""
tbxSumWkPrem = ""
End If
End If
If tickDT = False Then
If tickDO = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem), 2)
End If
End If
End If
'If tickDO = True Then tickDT = False
' If tickIP = True Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem + VtbxAnPremSD), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem + VtbxWkPremSD), 2)
' If tickIP = False Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem), 2)
If tickDO = False Then
If tickDT = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
End If
End If
End If
labelF:
If tickDT = True Then tickDO = False
End If
If cbxNoUDO = "" Then
cbxSIDO = ""
tbxDOAnPrem = ""
tbxDOWkPrem = ""
End If
End Sub
Private Sub cbxSIDT_Change()
'Calcs premium and recalcs relevant totals if DEATH AND TPD SUM INSURED
changed.
If cbxSIDT <> "" Then
If cbxAge < 65 Then
cbxNoUDT = cbxSIDT / valueAmtDT
tbxDTAnPrem = FormatCurrency((((cbxNoUDT *
ufAdmin.tbxAdminDTPrem.Value) * 52)), 0)
tbxDTWkPrem = FormatCurrency((cbxNoUDT *
ufAdmin.tbxAdminDTPrem.Value), 0)
Dim VtbxDTAnPrem As Double
Dim VtbxAnPremSD As Double
Dim VtbxDTWkPrem As Double
Dim VtbxWkPremSD As Double
Dim VtbxDOAnPrem As Double
Dim VtbxDOWkPrem As Double
If IsNumeric(tbxDOAnPrem) = True Then
VtbxDOAnPrem = tbxDOAnPrem
Else: VtbxDOAnPrem = 0
End If
If IsNumeric(tbxDOWkPrem) = True Then
VtbxDOWkPrem = tbxDOWkPrem
Else: VtbxDOWkPrem = 0
End If
If IsNumeric(tbxDTAnPrem) = True Then
VtbxDTAnPrem = tbxDTAnPrem
Else: VtbxDTAnPrem = 0
End If
If IsNumeric(tbxDTWkPrem) = True Then
VtbxDTWkPrem = tbxDTWkPrem
Else: VtbxDTWkPrem = 0
End If
If IsNumeric(tbxWkPremSD) = True Then
VtbxWkPremSD = tbxWkPremSD
Else: VtbxWkPremSD = 0
End If
If IsNumeric(tbxAnPremSD) = True Then
VtbxAnPremSD = tbxAnPremSD
Else: VtbxAnPremSD = 0
End If
If tickDT = True Then tickDO = False
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
If tickDT = False Then
If tickDO = False Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = ""
tbxSumWkPrem = ""
End If
End If
If tickDT = False Then
If tickDO = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem), 2)
End If
End If
End If
'If tickDO = True Then tickDT = False
' If tickIP = True Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem + VtbxAnPremSD), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem + VtbxWkPremSD), 2)
' If tickIP = False Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem), 2)
If tickDO = False Then
If tickDT = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
End If
End If
End If
labelF:
If tickDT = True Then tickDO = False
End If
End If
If cbxSIDT = "" Then
cbxNoUDT = ""
tbxDTAnPrem = ""
tbxDTWkPrem = ""
End If
End Sub
Private Sub cbxNoUDT_Change()
'Calcs premium and recalcs relevant totals if NO OF UNITS DEATH AND
TPD changed.
If cbxNoUDT <> "" Then
If cbxAge < 65 Then
cbxSIDT = FormatCurrency((cbxNoUDT * valueAmtDT), 0)
tbxDTAnPrem = FormatCurrency((((cbxNoUDT *
ufAdmin.tbxAdminDTPrem.Value) * 52)), 0)
tbxDTWkPrem = FormatCurrency((cbxNoUDT *
ufAdmin.tbxAdminDTPrem.Value), 0)
Dim VtbxDTAnPrem As Double
Dim VtbxAnPremSD As Double
Dim VtbxDTWkPrem As Double
Dim VtbxWkPremSD As Double
Dim VtbxDOAnPrem As Double
Dim VtbxDOWkPrem As Double
If IsNumeric(tbxDOAnPrem) = True Then
VtbxDOAnPrem = tbxDOAnPrem
Else: VtbxDOAnPrem = 0
End If
If IsNumeric(tbxDOWkPrem) = True Then
VtbxDOWkPrem = tbxDOWkPrem
Else: VtbxDOWkPrem = 0
End If
If IsNumeric(tbxDTAnPrem) = True Then
VtbxDTAnPrem = tbxDTAnPrem
Else: VtbxDTAnPrem = 0
End If
If IsNumeric(tbxDTWkPrem) = True Then
VtbxDTWkPrem = tbxDTWkPrem
Else: VtbxDTWkPrem = 0
End If
If IsNumeric(tbxWkPremSD) = True Then
VtbxWkPremSD = tbxWkPremSD
Else: VtbxWkPremSD = 0
End If
If IsNumeric(tbxAnPremSD) = True Then
VtbxAnPremSD = tbxAnPremSD
Else: VtbxAnPremSD = 0
End If
If tickDT = True Then tickDO = False
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
If tickDT = False Then
If tickDO = False Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = ""
tbxSumWkPrem = ""
End If
End If
If tickDT = False Then
If tickDO = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem), 2)
End If
End If
End If
'If tickDO = True Then tickDT = False
' If tickIP = True Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem + VtbxAnPremSD), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem + VtbxWkPremSD), 2)
' If tickIP = False Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem), 2)
If tickDO = False Then
If tickDT = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
End If
End If
End If
labelF:
If tickDT = True Then tickDO = False
End If
End If
If cbxNoUDT = "" Then
cbxSIDT = ""
tbxDTAnPrem = ""
tbxDTWkPrem = ""
End If
End Sub
'Private Sub cbxNoH_AfterUpdate()
Private Sub cbxNoH_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'If NO OF HOURS WORKED PER WEEK changed does the following.
If cbxNoH = "" Then
cbxNoUDT.Locked = True
cbxSIDT.Locked = True
tbxSal.Locked = True
tickIP.Locked = True
tickDO.Locked = True
tickDT.Locked = True
'End If
'If greater than 15 hours per week then Income Protection available,
'and the relevant TPD definition is displayed.
ElseIf cbxNoH > 14 Then
'Clear all fields in the income protection frame.
tbxWkBenN = ""
tbxWkBenS = ""
tbxWkBenT = ""
tbxAnPrem = ""
tbxWkPrem = ""
tbxAnPremSD = ""
tbxWkPremSD = ""
tbxNoUIP = ""
tbxEligible = ""
tbxSal = ""
tbxOcCat = ""
cbxOcCat = ""
tbxEligible = "Based on the no. of hours worked you are eligible to
apply for Income Protection Insurance through LUCRF."
tbxTPDDef = "Two limbs, six months off work and not able to work in
occupation."
cbxOcCat.Locked = False
cmdLookUp.Locked = False
tbxSal.Locked = False
tickIP.Locked = False
tickDO.Locked = False
tickDT.Locked = False
'Other wise if equal to or less than 14 then all IP frame fields
cleared
'and a message displayed in the eligibility tbx.
'End If
'If cbxNoH < 15 Then
Else:
tbxEligible = "INCOME PROTECTION NOT AVAILABLE TO MEMBERS WORKING
LESS THAN 15 HOURS PER WEEK"
tbxTPDDef = "Loss of independent existence."
tickIP = False
cbxOcCat.Locked = True
cmdLookUp.Locked = True
tbxSal.Locked = True
tickIP.Locked = True
cbxOcCat = "NA"
tbxSal = "NA"
tbxWkBenN = "NA"
tbxWkBenS = "NA"
tbxWkBenT = "NA"
tbxAnPrem = "NA"
tbxWkPrem = "NA"
tbxAnPremSD = "NA"
tbxWkPremSD = "NA"
tbxNoUIP = "NA"
End If
End Sub
Private Sub tbxSal_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
'do nothing
Case Else
Beep
KeyAscii = 0
End Select
End Sub
Private Sub tbxSal_AfterUpdate()
'Private Sub tbxSal_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Calcs Income Protection Benefits and premium and "DEATH ONLY/TPD + IP"
total benefits
' and recalculates if salary changed.
If tbxSal <> "" Then
If IsNumeric(tbxSal) = True Then
Dim BenN As Double
Dim BenS As Double
Dim BenT As Double
Dim maxbenN As Double
Dim maxbenS As Double
Dim maxbenT As Double
maxben = Range("Admin!B10")
maxbenN = Range("Admin!C10") / 100
maxbenS = Range("Admin!D10") / 100
maxbenT = maxbenN + maxbenS
MaxSal = Round((maxben / (((Range("Admin!C10") +
Range("Admin!D10")) / 100))), 2)
BenT = (Int(((tbxSal * maxbenT) / 52) / 100)) * 100
BenN = (((BenT * 52) / maxbenT) * maxbenN) / 52
BenS = (((BenT * 52) / maxbenT) * maxbenS) / 52
If tbxSal > MaxSal Then
BenT = Int((MaxSal * maxbenT) / 52)
BenN = (((BenT * 52) / maxbenT) * maxbenN) / 52
BenS = (((BenT * 52) / maxbenT) * maxbenS) / 52
End If
tbxWkBenN = FormatCurrency(BenN, 2)
tbxWkBenS = FormatCurrency(BenS, 2)
tbxWkBenT = FormatCurrency((BenN + BenS), 2)
End If
End If
If IsNumeric(tbxSal) = True Then
If cbxOcCat <> "" Then
Dim Col As String 'Premium Rate Column
Dim Row As String 'Age row
Dim PR As String 'Cell location containing Premium Rate
Row = cbxAge - 11
If cbxSex = "Male" Then
Select Case cbxOcCat
Case Is = ("White Collar")
Col = "B"
Case Is = ("Light Blue Collar")
Col = "D"
Case Else
Col = "F"
End Select
ElseIf cbxSex = "Female" Then
Select Case cbxOcCat
Case Is = ("White Collar")
Col = "C"
Case Is = ("Light Blue Collar")
Col = "E"
Case Else
Col = "G"
End Select
End If
'Points to admin work sheet for stamp duty rate relevant to state
where member resides.
'Stamp duty adds between 5% and 11% to
'Income Protection premium depending on where the member lives
If cbxState = "Qld" Then stampD = (Range("Admin!B14") / 100) + 1
If cbxState = "NSW" Then stampD = (Range("Admin!B15") / 100) + 1
If cbxState = "ACT" Then stampD = (Range("Admin!B16") / 100) + 1
If cbxState = "Vic" Then stampD = (Range("Admin!B17") / 100) + 1
If cbxState = "Tas" Then stampD = (Range("Admin!B18") / 100) + 1
If cbxState = "SA" Then stampD = (Range("Admin!B19") / 100) + 1
If cbxState = "WA" Then stampD = (Range("Admin!B20") / 100) + 1
If cbxState = "NT" Then stampD = (Range("Admin!B21") / 100) + 1
PR = Col & Row
tbxNoUIP = Int(tbxWkBenT / 100)
tbxAnPrem = FormatCurrency((tbxNoUIP *
(Worksheets("WeekPrem").Range(PR).Value) * 52), 2)
tbxWkPrem = FormatCurrency((tbxNoUIP *
(Worksheets("WeekPrem").Range(PR).Value)), 2)
tbxWkPremSD = FormatCurrency(((((Round((tbxNoUIP *
(Worksheets("WeekPrem").Range(PR).Value)), 2) * 13)) * stampD) / 13),
2)
tbxAnPremSD = FormatCurrency((((((Round((tbxNoUIP *
(Worksheets("WeekPrem").Range(PR).Value)), 2) * 13)) * stampD) / 13) *
52), 2)
'ROUNDING???????????
End If
End If
Dim VtbxDTAnPrem As Double
Dim VtbxAnPremSD As Double
Dim VtbxDTWkPrem As Double
Dim VtbxWkPremSD As Double
Dim VtbxDOAnPrem As Double
Dim VtbxDOWkPrem As Double
If IsNumeric(tbxDOAnPrem) = True Then
VtbxDOAnPrem = tbxDOAnPrem
Else: VtbxDOAnPrem = 0
End If
If IsNumeric(tbxDOWkPrem) = True Then
VtbxDOWkPrem = tbxDOWkPrem
Else: VtbxDOWkPrem = 0
End If
If IsNumeric(tbxDTAnPrem) = True Then
VtbxDTAnPrem = tbxDTAnPrem
Else: VtbxDTAnPrem = 0
End If
If IsNumeric(tbxDTWkPrem) = True Then
VtbxDTWkPrem = tbxDTWkPrem
Else: VtbxDTWkPrem = 0
End If
If IsNumeric(tbxWkPremSD) = True Then
VtbxWkPremSD = tbxWkPremSD
Else: VtbxWkPremSD = 0
End If
If IsNumeric(tbxAnPremSD) = True Then
VtbxAnPremSD = tbxAnPremSD
Else: VtbxAnPremSD = 0
End If
If tickDT = True Then tickDO = False
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
If tickDT = False Then
If tickDO = False Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = ""
tbxSumWkPrem = ""
End If
End If
If tickDT = False Then
If tickDO = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem), 2)
End If
End If
End If
'If tickDO = True Then tickDT = False
' If tickIP = True Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem + VtbxAnPremSD), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem + VtbxWkPremSD), 2)
' If tickIP = False Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem), 2)
If tickDO = False Then
If tickDT = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
End If
End If
End If
labelF:
If tickDT = True Then tickDO = False
End Sub
Private Sub cbxOcCat_Change()
'Recalculates this if OCCUPATION CATEGORY CHANGED.
If cbxOcCat = "Not Available" Then
'Clear all fields in the income protection frame.
tbxWkBenN = ""
tbxWkBenS = ""
tbxWkBenT = ""
tbxAnPrem = ""
tbxWkPrem = ""
tbxAnPremSD = ""
tbxWkPremSD = ""
tbxNoUIP = ""
tbxEligible = ""
tbxSal = ""
tbxOcCat = ""
cbxOcCat = ""
tickIP = False
tbxEligible = "Based on your occupation you are not eligible to apply
for income protection through LUCRF."
End If
If cbxOcCat = "Individual Consideration" Then
'Clear all fields in the income protection frame.
tbxWkBenN = ""
tbxWkBenS = ""
tbxWkBenT = ""
tbxAnPrem = ""
tbxWkPrem = ""
tbxAnPremSD = ""
tbxWkPremSD = ""
tbxNoUIP = ""
tbxEligible = ""
tbxSal = ""
tbxOcCat = ""
cbxOcCat = ""
tickIP = False
tbxEligible = "Your occupation requires further assesment before a
premium estimate can be provided, please contact ING for more
information."
End If
If tbxSal <> "" Then
If IsNumeric(tbxSal) = True Then
Dim BenN As Double
Dim BenS As Double
Dim BenT As Double
Dim maxbenN As Double
Dim maxbenS As Double
Dim maxbenT As Double
maxben = Range("Admin!B10")
maxbenN = Range("Admin!C10") / 100
maxbenS = Range("Admin!D10") / 100
maxbenT = maxbenN + maxbenS
MaxSal = Round((maxben / (((Range("Admin!C10") +
Range("Admin!D10")) / 100))), 2)
BenT = (Int(((tbxSal * maxbenT) / 52) / 100)) * 100
BenN = (((BenT * 52) / maxbenT) * maxbenN) / 52
BenS = (((BenT * 52) / maxbenT) * maxbenS) / 52
If tbxSal > MaxSal Then
BenT = Int((MaxSal * maxbenT) / 52)
BenN = (((BenT * 52) / maxbenT) * maxbenN) / 52
BenS = (((BenT * 52) / maxbenT) * maxbenS) / 52
End If
tbxWkBenN = FormatCurrency(BenN, 2)
tbxWkBenS = FormatCurrency(BenS, 2)
tbxWkBenT = FormatCurrency((BenN + BenS), 2)
End If
End If
If IsNumeric(tbxSal) = True Then
If cbxOcCat <> "" Then
Dim Col As String 'Premium Rate Column
Dim Row As String 'Age row
Dim PR As String 'Cell location containing Premium Rate
Row = cbxAge - 11
If cbxSex = "Male" Then
Select Case cbxOcCat
Case Is = ("White Collar")
Col = "B"
Case Is = ("Light Blue Collar")
Col = "D"
Case Else
Col = "F"
End Select
ElseIf cbxSex = "Female" Then
Select Case cbxOcCat
Case Is = ("White Collar")
Col = "C"
Case Is = ("Light Blue Collar")
Col = "E"
Case Else
Col = "G"
End Select
End If
'Points to admin work sheet for stamp duty rate relevant to state
where member resides.
'Stamp duty adds between 5% and 11% to
'Income Protection premium depending on where the member lives
If cbxState = "Qld" Then stampD = (Range("Admin!B14") / 100) + 1
If cbxState = "NSW" Then stampD = (Range("Admin!B15") / 100) + 1
If cbxState = "ACT" Then stampD = (Range("Admin!B16") / 100) + 1
If cbxState = "Vic" Then stampD = (Range("Admin!B17") / 100) + 1
If cbxState = "Tas" Then stampD = (Range("Admin!B18") / 100) + 1
If cbxState = "SA" Then stampD = (Range("Admin!B19") / 100) + 1
If cbxState = "WA" Then stampD = (Range("Admin!B20") / 100) + 1
If cbxState = "NT" Then stampD = (Range("Admin!B21") / 100) + 1
PR = Col & Row
tbxNoUIP = Int(tbxWkBenT / 100)
tbxAnPrem = FormatCurrency((tbxNoUIP *
(Worksheets("WeekPrem").Range(PR).Value) * 52), 2)
tbxWkPrem = FormatCurrency((tbxNoUIP *
(Worksheets("WeekPrem").Range(PR).Value)), 2)
tbxWkPremSD = FormatCurrency((((Round((tbxNoUIP *
(Worksheets("WeekPrem").Range(PR).Value)), 2) * 13)) * stampD) / 13)
tbxAnPremSD = (FormatCurrency((((Round((tbxNoUIP *
(Worksheets("WeekPrem").Range(PR).Value)), 2) * 13)) * stampD) / 13)) *
52
End If
End If
Dim VtbxDTAnPrem As Double
Dim VtbxAnPremSD As Double
Dim VtbxDTWkPrem As Double
Dim VtbxWkPremSD As Double
Dim VtbxDOAnPrem As Double
Dim VtbxDOWkPrem As Double
If IsNumeric(tbxDOAnPrem) = True Then
VtbxDOAnPrem = tbxDOAnPrem
Else: VtbxDOAnPrem = 0
End If
If IsNumeric(tbxDOWkPrem) = True Then
VtbxDOWkPrem = tbxDOWkPrem
Else: VtbxDOWkPrem = 0
End If
If IsNumeric(tbxDTAnPrem) = True Then
VtbxDTAnPrem = tbxDTAnPrem
Else: VtbxDTAnPrem = 0
End If
If IsNumeric(tbxDTWkPrem) = True Then
VtbxDTWkPrem = tbxDTWkPrem
Else: VtbxDTWkPrem = 0
End If
If IsNumeric(tbxWkPremSD) = True Then
VtbxWkPremSD = tbxWkPremSD
Else: VtbxWkPremSD = 0
End If
If IsNumeric(tbxAnPremSD) = True Then
VtbxAnPremSD = tbxAnPremSD
Else: VtbxAnPremSD = 0
End If
If tickDT = True Then tickDO = False
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
If tickDT = False Then
If tickDO = False Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = ""
tbxSumWkPrem = ""
End If
End If
If tickDT = False Then
If tickDO = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem), 2)
End If
End If
End If
'If tickDO = True Then tickDT = False
' If tickIP = True Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem + VtbxAnPremSD), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem + VtbxWkPremSD), 2)
' If tickIP = False Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem), 2)
If tickDO = False Then
If tickDT = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
End If
End If
End If
labelE:
If tickDT = True Then tickDO = False
End Sub
Private Sub tickDO_AfterUpdate()
Dim VtbxDTAnPrem As Double
Dim VtbxAnPremSD As Double
Dim VtbxDTWkPrem As Double
Dim VtbxWkPremSD As Double
Dim VtbxDOAnPrem As Double
Dim VtbxDOWkPrem As Double
If IsNumeric(tbxDOAnPrem) = True Then
VtbxDOAnPrem = tbxDOAnPrem
Else: VtbxDOAnPrem = 0
End If
If IsNumeric(tbxDOWkPrem) = True Then
VtbxDOWkPrem = tbxDOWkPrem
Else: VtbxDOWkPrem = 0
End If
If IsNumeric(tbxDTAnPrem) = True Then
VtbxDTAnPrem = tbxDTAnPrem
Else: VtbxDTAnPrem = 0
End If
If IsNumeric(tbxDTWkPrem) = True Then
VtbxDTWkPrem = tbxDTWkPrem
Else: VtbxDTWkPrem = 0
End If
If IsNumeric(tbxWkPremSD) = True Then
VtbxWkPremSD = tbxWkPremSD
Else: VtbxWkPremSD = 0
End If
If IsNumeric(tbxAnPremSD) = True Then
VtbxAnPremSD = tbxAnPremSD
Else: VtbxAnPremSD = 0
End If
If tickDO = True Then tickDT = False
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem), 2)
End If
If tickDO = False Then
If tickDT = False Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = ""
tbxSumWkPrem = ""
End If
End If
End If
If tickDO = False Then
If tickDT = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
End If
End If
'labelD:
If tickDO = True Then tickDT = False
End Sub
Private Sub tickDT_AfterUpdate()
Dim VtbxDOAnPrem As Double
Dim VtbxDOWkPrem As Double
Dim VtbxDTAnPrem As Double
Dim VtbxDTWkPrem As Double
Dim VtbxAnPremSD As Double
Dim VtbxWkPremSD As Double
If IsNumeric(tbxDOAnPrem) = True Then
VtbxDOAnPrem = tbxDOAnPrem
Else: VtbxDOAnPrem = 0
End If
If IsNumeric(tbxDOWkPrem) = True Then
VtbxDOWkPrem = tbxDOWkPrem
Else: VtbxDOWkPrem = 0
End If
If IsNumeric(tbxDTAnPrem) = True Then
VtbxDTAnPrem = tbxDTAnPrem
Else: VtbxDTAnPrem = 0
End If
If IsNumeric(tbxDTWkPrem) = True Then
VtbxDTWkPrem = tbxDTWkPrem
Else: VtbxDTWkPrem = 0
End If
If IsNumeric(tbxWkPremSD) = True Then
VtbxWkPremSD = tbxWkPremSD
Else: VtbxWkPremSD = 0
End If
If IsNumeric(tbxAnPremSD) = True Then
VtbxAnPremSD = tbxAnPremSD
Else: VtbxAnPremSD = 0
End If
If tickDT = True Then tickDO = False
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
If tickDT = False Then
If tickDO = False Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = ""
tbxSumWkPrem = ""
End If
End If
End If
If tickDT = False Then
If tickDO = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem), 2)
End If
End If
End If
labelA:
If tickDT = True Then tickDO = False
End Sub
Private Sub tickIP_AfterUpdate()
Dim VtbxDTAnPrem As Double
Dim VtbxAnPremSD As Double
Dim VtbxDTWkPrem As Double
Dim VtbxWkPremSD As Double
Dim VtbxDOAnPrem As Double
Dim VtbxDOWkPrem As Double
If IsNumeric(tbxDOAnPrem) = True Then
VtbxDOAnPrem = tbxDOAnPrem
Else: VtbxDOAnPrem = 0
End If
If IsNumeric(tbxDOWkPrem) = True Then
VtbxDOWkPrem = tbxDOWkPrem
Else: VtbxDOWkPrem = 0
End If
If IsNumeric(tbxDTAnPrem) = True Then
VtbxDTAnPrem = tbxDTAnPrem
Else: VtbxDTAnPrem = 0
End If
If IsNumeric(tbxDTWkPrem) = True Then
VtbxDTWkPrem = tbxDTWkPrem
Else: VtbxDTWkPrem = 0
End If
If IsNumeric(tbxWkPremSD) = True Then
VtbxWkPremSD = tbxWkPremSD
Else: VtbxWkPremSD = 0
End If
If IsNumeric(tbxAnPremSD) = True Then
VtbxAnPremSD = tbxAnPremSD
Else: VtbxAnPremSD = 0
End If
If tickDT = True Then tickDO = False
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
If tickDT = False Then
If tickDO = False Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = ""
tbxSumWkPrem = ""
End If
End If
If tickDT = False Then
If tickDO = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDOAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDOWkPrem), 2)
End If
End If
End If
'If tickDO = True Then tickDT = False
' If tickIP = True Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem + VtbxAnPremSD), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem + VtbxWkPremSD), 2)
' If tickIP = False Then tbxSumAnPrem =
FormatCurrency((VtbxDOAnPrem), 2)
' tbxSumWkPrem =
FormatCurrency((VtbxDOWkPrem), 2)
If tickDO = False Then
If tickDT = True Then
If tickIP = True Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem +
VtbxAnPremSD), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem +
VtbxWkPremSD), 2)
End If
If tickIP = False Then
tbxSumAnPrem = FormatCurrency((VtbxDTAnPrem), 2)
tbxSumWkPrem = FormatCurrency((VtbxDTWkPrem), 2)
End If
End If
End If
End If
labelB:
If tickDT = True Then tickDO = False
End Sub
'Prints Screen. Needs work....Print to file would be better.
Private Sub cmdPrint_Click()
ufCombIns.Zoom = 87
tbxDis.Visible = False
tbxDisDis.Visible = True
ufCombIns.PrintForm
tbxDisDis.Visible = False
tbxDis.Visible = True
Dim hit As Integer
hit = ActiveWindow.UsableHeight
If hit < 490 Then
ufCombIns.Zoom = 89
ufCombIns.Width = 594
Else: ufCombIns.Zoom = 100
End If
End Sub
Private Sub cbxZoom_Change()
'cbxZoom.List = Array("100%", "95%", "90%", "85%", "80%", "75%", "70%",
"60%")
If cbxZoom <> "" Then
Select Case cbxZoom
Case Is = "100%"
ufCombIns.Zoom = 100
Case Is = "95%"
ufCombIns.Zoom = 95
Case Is = "90%"
ufCombIns.Zoom = 90
Case Is = "85%"
ufCombIns.Zoom = 85
Case Is = "80%"
ufCombIns.Zoom = 80
Case Is = "75%"
ufCombIns.Zoom = 75
Case Is = "70%"
ufCombIns.Zoom = 70
Case Is = "60%"
ufCombIns.Zoom = 60
Case Is = "Laptop"
ufCombIns.Zoom = 89
End Select
End If
End Sub
