Private Sub CloseCommandButton_Click()
Unload Me
End Sub
Private Sub ComboBox4_Change()
End Sub
Private Sub GenderComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
With Me.GenderComboBox
If .Text = "M" Or .Text = "F" Or .Text = "" Then
.BackColor = rgbWhite
Label4.Caption = "Gender"
Label4.ForeColor = rgbBlack
Else
Label4.Caption = "Please select M or F"
Label4.ForeColor = RGB(255, 55, 55)
.BackColor = RGB(255, 55, 55)
GenderComboBox.Value = ""
End If
End With
End Sub
Private Sub SGenderComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
With Me.SGenderComboBox
If .Text = "M" Or .Text = "F" Or .Text = "" Then
.BackColor = rgbWhite
Label24.Caption = "Gender"
Label24.ForeColor = rgbBlack
Else
Label24.Caption = "Please select M or F"
Label24.ForeColor = RGB(255, 55, 55)
.BackColor = RGB(255, 55, 55)
SGenderComboBox.Value = ""
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim objControl As MSForms.Control
For Each objControl In Me.Controls
If TypeName(objControl) = "TextBox" And objControl.Tag <> "" Then
Me.setupPlaceholder objControl.Name, False
End If
Next objControl
MultiPage1.Value = 0
Me.FirstNameTextBox.SetFocus
Me.FirstNameTextBox.Value = Sheet11.Range("C9").Value
'Fill all 'Month' combo boxes with valid months
Dim MonthAry(1 To 12) As Variant, ComboAry As Variant
Dim i As Long
ComboAry = Array("B", "R", "C", "O", "SB", "SR", "SC", "SO")
For i = 1 To 12
MonthAry(i) = MonthName(i)
Next i
For i = 0 To UBound(ComboAry)
Me.Controls(ComboAry(i) & "Month").List = MonthAry
Next i
'Fill all 'Day' combo boxes with valid days
Dim Arry As Variant
Arry = Evaluate("if({1},row(1:31))")
Me.BDay.List = Arry
Me.RDay.List = Arry
Me.CDay.List = Arry
Me.ODay.List = Arry
Me.SBDay.List = Arry
Me.SRDay.List = Arry
Me.SCDay.List = Arry
Me.SODay.List = Arry
'Fill all 'Year' combo boxes with valid years
Dim Ary As Variant
Ary = Evaluate("if({1},row(1930:2130))")
Me.BYear.List = Ary
Me.RYear.List = Ary
Me.CYear.List = Ary
Me.OYear.List = Ary
Me.SBYear.List = Ary
Me.SRYear.List = Ary
Me.SCYear.List = Ary
Me.SOYear.List = Ary
'Fill 'Gender' combo box with valid genders
Me.GenderComboBox.List = Array("M", "F")
Me.GenderComboBox.Style = fmStyleDropDownCombo
'Force users to choose from combo boxes
Me.BMonth.Style = 2
Me.BDay.Style = 2
Me.BYear.Style = 2
Me.SBMonth.Style = 2
Me.SBDay.Style = 2
Me.SBYear.Style = 2
Me.RMonth.Style = 2
Me.RDay.Style = 2
Me.RYear.Style = 2
Me.SRMonth.Style = 2
Me.SRDay.Style = 2
Me.SRYear.Style = 2
Me.CMonth.Style = 2
Me.CDay.Style = 2
Me.CYear.Style = 2
Me.SCMonth.Style = 2
Me.SCDay.Style = 2
Me.SCYear.Style = 2
Me.OMonth.Style = 2
Me.ODay.Style = 2
Me.OYear.Style = 2
Me.SOMonth.Style = 2
Me.SODay.Style = 2
Me.SOYear.Style = 2
'Fill 'Pension Provider' combo boxes with list of Canadian pension providers
Dim LastRow As Long
Dim SheetName As String
SheetName = "Sheet20"
LastRow = Sheets(SheetName).Cells(Rows.Count, "A").End(xlUp).Row
Me.ProviderComboBox.List = Sheets("Sheet20").Range("A2:A" & LastRow).Value
Me.SProviderComboBox.List = Sheets("Sheet20").Range("A2:A" & LastRow).Value
'Fill 'Pension Option' combo boxes with list of popular pension options
Me.OptionComboBox.List = Array("100% Joint Life", _
"100% Joint Life 5-year guarantee", "100% Joint Life 10-year guarantee", "100% Joint Life 15-year guarantee", _
"75% Joint Life 5-year guarantee", "75% Joint Life 10-year guarantee", "75% Joint Life 15-year guarantee", _
"60% Joint Life 5-year guarantee", "60% Joint Life 10-year guarantee", "60% Joint Life 15-year guarantee", _
"Single Life", _
"Single Life 5-year guarantee", "Single Life 10-year guarantee", "Single Life 15-year guarantee", _
"Other")
'Fill 'Spouse/Partner Gender' combo box with valid genders
Me.SGenderComboBox.List = Array("M", "F")
Me.SGenderComboBox.Style = fmStyleDropDownCombo
'Fill 'Spouse/Partner Pension Option' combo boxes with list of popular pension options
Me.SOptionComboBox.List = Array("100% Joint Life", _
"100% Joint Life 5-year guarantee", "100% Joint Life 10-year guarantee", "100% Joint Life 15-year guarantee", _
"75% Joint Life 5-year guarantee", "75% Joint Life 10-year guarantee", "75% Joint Life 15-year guarantee", _
"60% Joint Life 5-year guarantee", "60% Joint Life 10-year guarantee", "60% Joint Life 15-year guarantee", _
"Single Life", _
"Single Life 5-year guarantee", "Single Life 10-year guarantee", "Single Life 15-year guarantee", _
"Other")
End Sub
'Set focus to first available box on each tab of the multi-page userForm
Private Sub MultiPage1_Change()
GetTextBoxByTabIndex(Me.MultiPage1.SelectedItem, 0).SetFocus
End Sub
Private Function GetTextBoxByTabIndex(ByVal ControlParent As Object, ByVal TabIndex As Long) As Control
Dim oCtrl As Control
For Each oCtrl In ControlParent.Controls
If TypeOf oCtrl Is MSForms.TextBox Then
If oCtrl.TabIndex = TabIndex Then
Set GetTextBoxByTabIndex = oCtrl
Exit For
End If
End If
Next oCtrl
End Function
Private Sub OKCommandButton_Click()
'Combine month, day, year into valid dates
Dim DOB As Variant
On Error Resume Next
DOB = DateSerial(Me.BYear, Month(DateValue(Me.BMonth & "/01/2020")), Me.BDay)
On Error GoTo 0
Dim RD As Variant
On Error Resume Next
RD = DateSerial(Me.RYear, Month(DateValue(Me.RMonth & "/01/2020")), Me.RDay)
On Error GoTo 0
Dim CSD As Variant
On Error Resume Next
CSD = DateSerial(Me.CYear, Month(DateValue(Me.CMonth & "/01/2020")), Me.CDay)
On Error GoTo 0
Dim OSD As Variant
On Error Resume Next
OSD = DateSerial(Me.OYear, Month(DateValue(Me.OMonth & "/01/2020")), Me.ODay)
On Error GoTo 0
Dim SDOB As Variant
On Error Resume Next
SDOB = DateSerial(Me.SBYear, Month(DateValue(Me.SBMonth & "/01/2020")), Me.SBDay)
On Error GoTo 0
Dim SRD As Variant
On Error Resume Next
SRD = DateSerial(Me.SRYear, Month(DateValue(Me.SRMonth & "/01/2020")), Me.SRDay)
On Error GoTo 0
Dim SCSD As Variant
On Error Resume Next
SCSD = DateSerial(Me.SCYear, Month(DateValue(Me.SCMonth & "/01/2020")), Me.SCDay)
On Error GoTo 0
Dim SOSD As Variant
On Error Resume Next
SOSD = DateSerial(Me.SOYear, Month(DateValue(Me.SOMonth & "/01/2020")), Me.SODay)
On Error GoTo 0
With Sheets(11)
'Send data to sheets
If Not AllmostEmpty(FirstNameTextBox) Then .Range("C9").Value = FirstNameTextBox.Value
If LastNameTextBox <> "Optional" Then
If Not AllmostEmpty(LastNameTextBox) Then .Range("D9").Value = LastNameTextBox.Value
End If
If IsDate(DOB) Then .Range("E9").Value = DOB
If Not AllmostEmpty(GenderComboBox) Then .Range("F9").Value = GenderComboBox.Value
If CompanyTextBox <> "Optional" Then
If Not AllmostEmpty(CompanyTextBox) Then .Range("G9").Value = CompanyTextBox.Value
End If
If IsDate(RD) Then .Range("C15").Value = RD
If Not AllmostEmpty(OptionComboBox) Then .Range("D15").Value = OptionComboBox.Value
If Not AllmostEmpty(ProviderComboBox) Then .Range("E15").Value = ProviderComboBox.Value
If IsDate(CSD) Then .Range("F15").Value = CSD
If IsDate(OSD) Then .Range("G15").Value = OSD
End With
With Sheets(11)
If Not AllmostEmpty(SFirstNameTextBox) Then .Range("C11").Value = SFirstNameTextBox.Value
If SLastNameTextBox <> "Optional" Then
If Not AllmostEmpty(SLastNameTextBox) Then .Range("D11").Value = SLastNameTextBox.Value
End If
If IsDate(SDOB) Then .Range("E11").Value = SDOB
If Not AllmostEmpty(SGenderComboBox) Then .Range("F11").Value = SGenderComboBox.Value
If SCompanyTextBox <> "Optional" Then
If Not AllmostEmpty(SCompanyTextBox) Then .Range("G11").Value = SCompanyTextBox.Value
End If
If IsDate(SRD) Then .Range("C17").Value = SRD
If Not AllmostEmpty(SOptionComboBox) Then .Range("D17").Value = SOptionComboBox.Value
If Not AllmostEmpty(SProviderComboBox) Then .Range("E17").Value = SProviderComboBox.Value
If IsDate(SCSD) Then .Range("F17").Value = SCSD
If IsDate(SOSD) Then .Range("G17").Value = SOSD
End With
Unload Me
End Sub
'Set textbox tags to gray
Sub setupPlaceholder(txtBox As String, focus As Boolean)
With Me.Controls(txtBox)
If Len(.Text) = 0 And Not focus Then
.Text = .Tag
.ForeColor = vbGrayText
ElseIf .Text = .Tag Then
.Text = ""
.ForeColor = vbWindowText
End If
End With
End Sub
Private Sub LastNameTextBox_Enter()
setupPlaceholder LastNameTextBox.Name, True
End Sub
Private Sub LastNameTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
setupPlaceholder LastNameTextBox.Name, False
End Sub
Private Sub CompanyTextBox_Enter()
setupPlaceholder CompanyTextBox.Name, True
End Sub
Private Sub CompanyTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
setupPlaceholder CompanyTextBox.Name, False
End Sub
Private Sub SLastNameTextBox_Enter()
setupPlaceholder SLastNameTextBox.Name, True
End Sub
Private Sub SLastNameTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
setupPlaceholder SLastNameTextBox.Name, False
End Sub
Private Sub SCompanyTextBox_Enter()
setupPlaceholder SCompanyTextBox.Name, True
End Sub
Private Sub SCompanyTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
setupPlaceholder SCompanyTextBox.Name, False
End Sub
'Limit number of characters in each textbox or combobox
Private Sub ProviderComboBox_Change()
If ProviderComboBox.TextLength > 42 Then
MsgBox "Please limit your input to 42 characters."
ProviderComboBox.Text = Left(ProviderComboBox, ProviderComboBox.TextLength - 1)
End If
End Sub
Private Sub SProviderComboBox_Change()
If SProviderComboBox.TextLength > 42 Then
MsgBox "Please limit your input to 42 characters."
SProviderComboBox.Text = Left(SProviderComboBox, SProviderComboBox.TextLength - 1)
End If
End Sub
Private Sub OptionComboBox_Change()
If OptionComboBox.TextLength > 34 Then
MsgBox "Please limit your input to 34 characters."
OptionComboBox.Text = Left(OptionComboBox, OptionComboBox.TextLength - 1)
End If
End Sub
Private Sub SOptionComboBox_Change()
If SOptionComboBox.TextLength > 34 Then
MsgBox "Please limit your input to 34 characters."
SOptionComboBox.Text = Left(SOptionComboBox, SOptionComboBox.TextLength - 1)
End If
End Sub
Private Sub FirstNameTextBox_Change()
If FirstNameTextBox.TextLength > 13 Then
MsgBox "Please limit your input to 13 characters."
FirstNameTextBox.Text = Left(FirstNameTextBox, FirstNameTextBox.TextLength - 1)
End If
End Sub
Private Sub SFirstNameTextBox_Change()
If SFirstNameTextBox.TextLength > 13 Then
MsgBox "Please limit your input to 13 characters."
SFirstNameTextBox.Text = Left(SFirstNameTextBox, SFirstNameTextBox.TextLength - 1)
End If
End Sub
Private Sub LastNameTextBox_Change()
If LastNameTextBox.TextLength > 28 Then
MsgBox "Please limit your input to 28 characters."
LastNameTextBox.Text = Left(LastNameTextBox, LastNameTextBox.TextLength - 1)
End If
End Sub
Private Sub SLastNameTextBox_Change()
If SLastNameTextBox.TextLength > 28 Then
MsgBox "Please limit your input to 28 characters."
SLastNameTextBox.Text = Left(SLastNameTextBox, SLastNameTextBox.TextLength - 1)
End If
End Sub
Private Sub CompanyTextBox_Change()
If CompanyTextBox.TextLength > 30 Then
MsgBox "Please limit your input to 30 characters."
CompanyTextBox.Text = Left(CompanyTextBox, CompanyTextBox.TextLength - 1)
End If
End Sub
Private Sub SCompanyTextBox_Change()
If SCompanyTextBox.TextLength > 30 Then
MsgBox "Please limit your input to 30 characters."
SCompanyTextBox.Text = Left(SCompanyTextBox, SCompanyTextBox.TextLength - 1)
End If
End Sub