Re: Userform: Required Fields on Active Multipage Only
Can anyone take a crack at this with me?
Re: Userform: Required Fields on Active Multipage Only
Can anyone take a crack at this with me?
Re: Userform: Required Fields on Active Multipage Only
The form is expanding so much that there are constantly a lot of fields that need to be hidden based on choices made in the process. In some of the more simple iterations, I have used conditions to set labels and field visibility but that code gets cumbersome as it's on a per field basis. Here's an example of one:
Private Sub cmbRescReason_Change()
'Makes Rescind Reasons Visible dependent on the entry in the RescReasons combobox
lblRescReasonEligibility.Visible = (cmbRescReason.ListIndex = 1)
lblRescReasonFalsification.Visible = (cmbRescReason.ListIndex = 2)
lblRescReasonProcError.Visible = (cmbRescReason.ListIndex = 3)
lblRescReasonAsterisk.Visible = (cmbRescReason.ListIndex = 1)
lblRescReasonAsterisk.Visible = (cmbRescReason.ListIndex = 2)
lblRescReasonAsterisk.Visible = (cmbRescReason.ListIndex = 3)
lblRescReasonDetailAsterisk.Visible = (cmbRescReason.ListIndex = 1)
lblRescReasonDetailAsterisk.Visible = (cmbRescReason.ListIndex = 2)
lblRescReasonDetailAsterisk.Visible = (cmbRescReason.ListIndex = 3)
cmbRescEligibility.Visible = (cmbRescReason.ListIndex = 1)
cmbRescFalsification.Visible = (cmbRescReason.ListIndex = 2)
cmbRescProcError.Visible = (cmbRescReason.ListIndex = 3)
'Makes Field Required Based on the Selection in RescReasons combobox
If Me.cmbRescReason.ListIndex = 1 Then
Me.cmbRescEligibility.Value = ""
Me.cmbRescEligibility.SetFocus
ElseIf Me.cmbRescReason.ListIndex = 2 Then
Me.cmbRescFalsification.Value = ""
Me.cmbRescFalsification.SetFocus
ElseIf Me.cmbRescReason.ListIndex = 3 Then
Me.cmbRescProcError.Value = ""
Me.cmbRescProcError.SetFocus
End If
End Sub
Display More
If there is a better way, I certainly don't know it. How would you handle a scenario where a combobox choice determines the visibility of multiple fields?
Re: Userform: Required Fields on Active Multipage Only
Paging royUK!
Quick question regarding your solution above.
If I needed to add another Multipage object inside of the previous Multipage object, is there any way that I can make those controls follow the same behavior?
For example: If the active page of Multipage1 has three textboxes and a combobox that populates Multipage 2. Multipage 2 has three text boxes on page 1 and two textboxes on page 2.
Can the code you provided be modified so that the three textboxes and the combobox on the active page of Multipage1 are required as well as the three text boxes on the active page of Multipage2...but NOT the two text boxes on the inactive pages (page 2) of Multipage2?
Re: Textbox: Date Format and Validation
Thanks for your response, cytop.
That code worked fine...I added it to the AfterUpdate event instead of the exit event as something seemed more preferential about that behavior. However, I'm trying to put the focus back on that textbox when there is an error and it's not working. Instead, it's going to the next input field in the Tab Order. Can you tell what I did wrong?
Private Sub tbOriginalSubmissionDate_AfterUpdate()
If IsDate(tbOriginalSubmissionDate.Text) Then
tbOriginalSubmissionDate.Text = Format(CDate(tbOriginalSubmissionDate.Text), "MM/DD/YYYY")
Else
Me.tbOriginalSubmissionDate.Value = ""
tbOriginalSubmissionDate.BackColor = &HFFFF&
MsgBox "Please enter a valid date."
tbOriginalSubmissionDate.SetFocus
End If
If IsDate(tbOriginalSubmissionDate.Text) Then
tbOriginalSubmissionDate.Text = Format(CDate(tbOriginalSubmissionDate.Text), "MM/DD/YYYY")
tbOriginalSubmissionDate.BackColor = &H80000005
End If
End Sub
Display More
Re: Textbox: Date Format and Validation
I guess no one has anything for this?
Good morning all,
I guess I'm handling parts of my data validation too rigidly. Currently, I enforce validation of dates using the following code:
Private Sub tbUHAEffectiveDate_AfterUpdate()
'Data Validation for Date Format
If Not tbUHAEffectiveDate.Value Like "##[/]##[/]####" Then
MsgBox "Please enter in MM/DD/YYYY format"
tbUHAEffectiveDate.SetFocus
End If
End Sub
I also default the box to show them the format in the Userform Initialize event:
However, the users would like to be able to enter their date format in formats resembling a date and have it converted on the back end instead. For example, if the user enters "01012016", "1/1/2016", "1-1-16", etc., any of those should be acceptable and converted.
This information is being submitted to a table on a worksheet in this workbook as follows and that part doesn't matter much to me because the table can convert it there.
Dim Escalations As Worksheet
Set Escalations = ThisWorkbook.Sheets("Escalations")
nr = Escalations.Cells(Rows.Count, 1).End(xlUp).Row + 1
.....
Escalations.Cells(nr, 61) = tbUHAEffectiveDate
........
Display More
However, I am passing that information from some of the date fields to an .HTMLbody tag where I perform a calculation for the number of workdays using the following code:
And then:
And I'm worried that a date in an improper format will result in an invalid operation performed.
Does anyone have a way to take entry resembling a date format and convert it to a date on the AfterUpdate event or in the Submit Click Event so that the conversion happens prior to the other actions?
What are your best practices when it comes to handling date fields?
As usual, any help is greatly appreciated!
Re: With Outmail - Conditional Email String for .HTMLBody tag
OMG...I'm so sorry to have wasted your time (and to have given you a headache) for such a simple problem! Wow.
Thanks for helping but now I'm embarrassed it was such an easy issue. lol
Good morning all,
I am currently using the With Outmail statement and the .HTMLbody tag to compose an HTML-formatted email. It works fine, however, since it is HTML, the end user is going to get a long email with much of it not needed. Here is the current code:
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = EscalationsForm.cmbArea
.CC = ""
.BCC = EscalationsForm.tbSubmitterEmail
.Subject = "Case # " & tbCaseID & "; " & cmbWhichEscalation & " from: " & EscalationsForm.cmbDistrict & " District; " & EscalationsForm.cmbEscalation_Type & " " & EscalationsForm.cmbF50CorrectionTypeMain & " " & EscalationsForm.cmbF50NextAction
.HTMLbody = "The following email is a Receipt of the Escalation you just submitted. Your New Case Number is <b>" & tbCaseID & "</b>. The HRSSC will respond to this Escalation by close of business on " & Format(DateExpected, "Long Date") & ".<br><H2>Submission Information:</h2>" & "<b>Date Sent: </b>" & EscalationsForm.tbTodaysDate & "<br><b>Escalation Type: </b>" & EscalationsForm.cmbEscalation_Type & "<br><b>Area: </b>" & EscalationsForm.cmbArea & "<br><b>District: </b>" & EscalationsForm.cmbDistrict & "<br><br><b>Submitter's Name: </b>" & EscalationsForm.tbSubmitterName & "<br><b>Phone: </b>" & EscalationsForm.tbSubmitterPhone & "<br><b>E-mail/ACE ID: </b>" & EscalationsForm.tbSubmitterEmail _
& "<br><h3><font color=blue>Escalation to Rescind Offers:</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbRescReq & " - " & EscalationsForm.tbRescReqTitle & "<br><b>Applicant's Name: </b>" & EscalationsForm.tbRescApplicantName & "<br><b>Description: </b>" & EscalationsForm.tbRescDescription _
& "<br><h3><font color=blue>Escalation for Correction to Support Team (Requisition and/or eJPR):</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbCRSTReq & " - " & EscalationsForm.tbCRSTReqTitle & "<br>" & "<h4>Please Add The Following Information:</h4>" & "<b>Name: </b>" & EscalationsForm.tbCRSTNameAdd & "<br><b>EIN: </b>" & EscalationsForm.tbCRSTEINAdd & "<br><b>Support Team Role: </b>" & EscalationsForm.cmbCRSTSupportAdd & "<br>" & "<h4>Please Remove The Following Information:</h4>" & "<b>Name: </b>" & EscalationsForm.tbCRSTNameRem & "<br><b>EIN: </b>" & EscalationsForm.tbCRSTEINRem & "<br><b>Support Team Role: </b>" & EscalationsForm.cmbCRSTSupportRem & "<br><br><b>Additional Details: </b>" & EscalationsForm.tbCRSTAdditional _
& "<br><h3><font color=blue>Escalation for eJPR Correction/Second Request/Request to Cancel Posting:</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbCeJPRReq & " - " & EscalationsForm.tbCeJPRReqTitle & "<h4>Option Chosen (TRUE = Change Requested; FALSE = No Change Needed):</h4>" & "<br><b>Contact Information: </b>" & EscalationsForm.chkeJPRContact & "<br>" & EscalationsForm.tbeJPRContact & "<br><b>Location: </b>" & EscalationsForm.chkeJPRLocation & "<br>" & EscalationsForm.tbeJPRLocation & "<br><b>Posting Date: </b>" & EscalationsForm.chkeJPRPosting & "<br>" & EscalationsForm.tbeJPRPosting & "<br><b>Requisition Title: </b>" & EscalationsForm.chkeJPRRequisition _
& EscalationsForm.tbeJPRRequisition & "<br>" & "<h4>eJPR Not Released:</h4><b>Date eJPR Submitted: </b>" & EscalationsForm.tbeJPRDateSubmitted & "<br>" & "<h4>Request to Cancel Posting:</h4><b>Reason for Cancellation: </b>" & EscalationsForm.cmbCeJPRR2Cancel & "<br><br><b>Additional Details: </b>" & EscalationsForm.tbCeJPRAdditional _
& "<br><h3><font color=blue>Escalation for Pre-Hire List Correction:</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbPHLReq & " - " & EscalationsForm.tbPHLReqTitle & "<br><h4>Which Option Describes Your Issue?</h4><b>Late Initial Pre-Hire List: </b>" & EscalationsForm.opCPHLLatePHL & "<br><b>Pre-Hire List Does Not Include All Applicants Originally Requested: </b>" & EscalationsForm.opCPHLMissing & "<br><b>Late Subsequent Pre-Hire List: </b>" & EscalationsForm.opCPHLLateSubPHL & "<br><b>If True, Date Requested: </b>" & EscalationsForm.tbCPHLDate & "<br><br><b>Additional Details: </b>" & EscalationsForm.tbPHLAdditional _
& "<br><h3><font color=blue>Escalation for Interview Results:</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbIntRReq & " - " & EscalationsForm.tbIntRReqTitle & "<h4>Which Option Best Describes Your Issue:</h4><b>Interview Results Submitted - Selections and Offers Have Not Been Made: </b>" & EscalationsForm.opIntROffersNotMade & "<br><br><b>Selections Not Made According to Selecting Officials/Interviewer's Expectations: </b>" & EscalationsForm.opIntRIncorrectSelections & "<br><b>If True, Details: </b>" & EscalationsForm.tbIntRDetails & "<br><br><b>Incorrect Number of Vacancies Filled: </b>" & EscalationsForm.opIntRVacanciesFilled & "<br><b>If True, Correct Number of Vacancies: </b>" & EscalationsForm.tbIntRCorrectVacancies & "<br><b>If True, Reason Vacancies Changed: </b>" & EscalationsForm.cmbIntRVacancies & "<br><br><b>Application Rejected in Error: </b>" & EscalationsForm.opIntRRejectedInError _
& "<br><b>Applicant's Name: </b>" & EscalationsForm.tbIntRApplicantNameRej & "<br><b>Reason Rejected in Error: </b>" & EscalationsForm.cmbIntRRejectedReason & "<br><br><b>Additional Comments/Details: </b>" & EscalationsForm.tbIntRAdditional _
& "<br><h3><font color=blue>Escalation for Unprocessed Hire Actions:</h3></font><h4>Applicant Details:</h4><b>Applicant's Name: </b>" & EscalationsForm.tbUHAApplicantName & "<br><b>Requisition #: </b>" & EscalationsForm.tbUHAReq & "<br><b>Applicant's EIN: </b>" & EscalationsForm.tbUHAEIN & "<br><b>Last 4 of Applicant's SSN: </b>" & EscalationsForm.tbUHALast4SSN & "<br><b>Applicant's Position #: </b>" & EscalationsForm.tbUHAPosition & "<br><b>Applicant's Effective Date: </b>" & EscalationsForm.tbUHAEffectiveDate & "<br><b>Which Form Are You Attaching to Correct: </b>" & EscalationsForm.cmbUHAForms _
& "<br><h3><font color=blue>Escalation for Form 50 Corrections:</h3></font><h4>Employee's Details:</h4><b>Employee's Name: </b>" & EscalationsForm.tbF50ApplicantName & "<br><b>Requisition #: </b>NB" & EscalationsForm.tbF50Req & "<br><b>Employee's EIN: </b>" & EscalationsForm.tbF50EIN & "<br><b>Position #: </b>" & EscalationsForm.tbF50Position & "<br><b>Employee's Effective Date: </b>" & EscalationsForm.tbF50EffectiveDate & "<br><br><b>Primary Action: </b>" & EscalationsForm.cmbF50CorrectionTypeMain & "<br><b>Secondary Action: </b>" & EscalationsForm.cmbF50NextAction & "<br><b>Final Action, If Needed: </b>" & EscalationsForm.cmbF50FinalAction & "<br><br><b>Additional Details: </b>" & EscalationsForm.tbF50Additional _
& "<br><h3><font color=blue>Escalation for Relative Standing Correction:</h3></font><b>Bid Cluster: </b>BC" & EscalationsForm.tbRSCBidCluster & "<br><b>Effective Date: </b>" & EscalationsForm.tbRSCEffectiveDate & "<br><b>Applicant's Name: </b>" & EscalationsForm.tbRSCNameCorrection & "<br><b>EIN: </b>" & EscalationsForm.tbRSCEINCorrection & "<h4>Corrections</h4><b>Current Seniority Info: <br>Date: </b>" & EscalationsForm.tbRSCCurrentDate & "<b>Rank: </b>" & EscalationsForm.tbRSCCurrentRank & "<b>Craft: </b>" & EscalationsForm.cmbRSCCurrentCraft & "<br><br><b>Expected Seniority Info: <br>Date: </b>" & EscalationsForm.tbRSCExpectedDate & "<b>Rank: </b>" & EscalationsForm.tbRSCExpectedRank & "<b>Craft: </b>" & EscalationsForm.cmbRSCExpectedCraft _
& "<h4>Initial Calculation</h4><b>Please Select The Crafts That Require Calculation:<br><br>City Carrier Assistants: </b>" & EscalationsForm.chkRSCCraftCA & "<br><b>PSE Clerks: </b>" & EscalationsForm.chkRSCCraftCK & "<br><b>Mail Handler Assistants: </b>" & EscalationsForm.chkRSCCraftMH & "<br><b>PSE Maintenance: </b>" & EscalationsForm.chkRSCCraftMN & "<br><b>PSE Motor Vehicle Services: </b>" & EscalationsForm.chkRSCCraftMV & "<br><b>Rural Carrier Assistants: </b>" & EscalationsForm.chkRSCCraftRU & "<br><br><b>Reason for the Request: </b>" & EscalationsForm.cmbRSCReason & "<br><br><b>Additional Comments/Details: </b>" & EscalationsForm.tbRSCAdditional
.Display
' .Send 'or use .Display
.Attachments.Add EscalationsForm.tbRescDocAttached.Value & EscalationsForm.tbUHADocAttached.Value & EscalationsForm.tbRSCDocAttached.Value
If tbRescDocAttached.Value <> "" Then
.Attach tbRescDocAttached.Value
ElseIf tbUHADocAttached.Value <> "" Then
.Attach tbUHADocAttached.Value
ElseIf tbRSCDocAttached.Value <> "" Then
.Attach tbRSCAttached.Value
End If
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Display More
What I am attempting to do is to use an If Else Statement combined with a String to use the field "cmbEscalation_Type" to determine which String the .HTMLBody tag should use. This way, I can make a different .HTMLbody formatted email for each of the choices in the cmbEscalation_Type combobox. I started off with the first line and I'm getting a "Compile error: Object Required" Error. It's pointing to the last value in the string, "EscalationsForm.tbRescDescription" I haven't even dealt with the change in conditions yet, but here is the code that generates that error:
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim RescindEmail As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set RescindEmail = "The following email is a Receipt of the Escalation you just submitted. Your New Case Number is <b>" & tbCaseID & "</b>. The HRSSC will respond to this Escalation by close of business on " & Format(DateExpected, "Long Date") & ".<br><H2>Submission Information:</h2>" & "<b>Date Sent: </b>" & EscalationsForm.tbTodaysDate & "<br><b>Escalation Type: </b>" & EscalationsForm.cmbEscalation_Type & "<br><b>Area: </b>" & EscalationsForm.cmbArea & "<br><b>District: </b>" & EscalationsForm.cmbDistrict & "<br><br><b>Submitter's Name: </b>" & EscalationsForm.tbSubmitterName & "<br><b>Phone: </b>" & EscalationsForm.tbSubmitterPhone & "<br><b>E-mail/ACE ID: </b>" & EscalationsForm.tbSubmitterEmail _
& "<br><h3><font color=blue>Escalation to Rescind Offers:</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbRescReq & " - " & EscalationsForm.tbRescReqTitle & "<br><b>Applicant's Name: </b>" & EscalationsForm.tbRescApplicantName & "<br><b>Description: </b>" & EscalationsForm.tbRescDescription
On Error Resume Next
With OutMail
.To = "EscalationsForm.cmbArea
.CC = ""
.BCC = EscalationsForm.tbSubmitterEmail
.Subject = "Case # " & tbCaseID & "; " & cmbWhichEscalation & " from: " & EscalationsForm.cmbDistrict & " District; " & EscalationsForm.cmbEscalation_Type & " " & EscalationsForm.cmbF50CorrectionTypeMain & " " & EscalationsForm.cmbF50NextAction
.HTMLbody = RescindEmail
.Display
' .Send 'or use .Display
.Attachments.Add EscalationsForm.tbRescDocAttached.Value & EscalationsForm.tbUHADocAttached.Value & EscalationsForm.tbRSCDocAttached.Value
If tbRescDocAttached.Value <> "" Then
.Attach tbRescDocAttached.Value
ElseIf tbUHADocAttached.Value <> "" Then
.Attach tbUHADocAttached.Value
ElseIf tbRSCDocAttached.Value <> "" Then
.Attach tbRSCAttached.Value
End If
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
Display More
Any help with the first part or even the conditional portion is greatly appreciated by this VBA Novice + (Still a novice, but gaining experience, lol). Thanks!
Re: Userform: Required Fields on Active Multipage Only
Figured it out! Thanks again for all of your help. What I did was modify your code to include a lookup for the "Tag" property then I included the word "Required" into that property for all the controls I wanted it to check. Instead of only using a Message Box, I also added some coloration to the Required field. Here's the modified code and THANKS AGAIN for all of your help!
Dim oCtl As MSForms.Control
Dim iPg As Integer
iPg = Me.MultiPage1.Value
For Each oCtl In Me.MultiPage1.Pages(iPg).Controls
Select Case TypeName(oCtl)
Case "TextBox"
If oCtl.Tag = "Required" Then
If oCtl.Value = vbNullString Then
oCtl.BackColor = &HFFFF&
MsgBox "The highlighted field is mandatory. Please fill it out and Submit again."
oCtl.SetFocus
Exit Sub
Else
oCtl.BackColor = &H80000005
End If
End If
Case Else:
End Select
Next oCtl
Display More
Re: Userform: Required Fields on Active Multipage Only
Uh oh...one problem.
QuoteOn Page 1 of the MultiPage1, there are three Text Boxes. A TextBox for SSN (Required), a TextBox for Date (Required), and a Multiline TextBox for Details (Not Required).
Pg1.JPG
On Page 2 of the MultiPage1, there are three Text Boxes. A TextBox for Height (Required), a TextBox for Weight, and a Multiline TextBox for Details (Required).
Pg2.JPG
In that response, I talked about not all of the fields on each page being Required for submission. Is there any way to specify which are mandatory and which are not? If I had Check boxes, can I make those fields not required? On each Multipage, there are only between 2 and 6 fields that are required.
Thoughts?
Re: Userform: Required Fields on Active Multipage Only
Quote from royUK;770872I'm not sure why you posted all that code. I posted code to check if the textboxes on the active page of the MultiPage have been completed. which is what you asked for. The code replaces your If ... ElseIf code to check the TextBoxes.
Thank you SO much. It works like a dream! The problem I had originally had nothing to do with the code to check for the active page of the Multipage...It was including "Page 1, Page 2, etc" in the list for the Combobox because I was already populating that field with a Named Reference (dynamic with Offset for growth) in the following code:
Anywho...it works perfectly! Thanks again for all your help and for putting up with me!
Re: Userform: Required Fields on Active Multipage Only
Quote from royUK;770850I can't see what sensitive information would be given away by having the controls & code on the userform.
Try this code
CodeDisplay MoreOption Explicit Private Sub cmdSubmit_Click() Dim oCtl As MSForms.Control Dim iPg As Integer iPg = Me.MultiPage1.Value For Each oCtl In Me.MultiPage1.Pages(iPg).Controls Select Case TypeName(oCtl) Case "TextBox" If oCtl.Value = vbNullString Then MsgBox oCtl.Name & " is mandatory. Please complete" oCtl.SetFocus Exit Sub End If Case Else: End Select Next oCtl MsgBox "EMAIL CAN BE SENT" ''/// put code to send email here End Sub Private Sub UserForm_Initialize() Dim iX As Integer ''/// will be dynamic depending on number og Pages on the Multipage 'Populates Combobox For iX = 1 To Me.MultiPage1.Pages.Count Me.ComboBox1.AddItem "Page " & iX Next iX End Sub Private Sub ComboBox1_Change() 'Changes Multipage based on ComboBox1 selection Me.MultiPage1.Value = Me.ComboBox1.ListIndex End Sub
Okay...I guess you're right. Sorry for the scariness, lol. I've stripped out the SSN Lookups, which were the main issues that I had, and I'm attaching the file.
I added your code into another version but I can't get it to work properly so I've taken it back to where it was prior to the attempt. Please excuse the very basic nature of my coding as this is my first venture into Userforms.
Sub OpenEscalationsForm()
EscalationsForm.Show
End Sub
Private Sub CommandButton2_Click()
'Code for Loading District ComboBox Value
Range("A1").Value = cmbDistrict.Value
End Sub
Private Sub cmbEscalation_Type_Change()
'Link Values in the ComboBox to Index entries on Multipage1
With Me
.MultiPage1.Value = .cmbEscalation_Type.ListIndex
End With
End Sub
Private Sub cmbArea_Change()
'Code For Loading District Combobox Based on Entry from Area Combobox
Dim index As Integer
index = cmbArea.ListIndex
cmbDistrict.Clear
Select Case index
Case Is = 0
With cmbDistrict
.AddItem "Atlanta"
.AddItem "Baltimore"
.AddItem "Capital"
.AddItem "Greater SC"
.AddItem "Greensboro"
.AddItem "Mid-Carolinas"
.AddItem "Northern VA"
.AddItem "Richmond"
End With
Case Is = 1
With cmbDistrict
.AddItem "Appalachian"
.AddItem "Central PA"
.AddItem "Kentuckiana"
.AddItem "Northern Ohio"
.AddItem "Ohio Valley"
.AddItem "Philadelphia"
.AddItem "South Jersey"
.AddItem "Tennessee"
.AddItem "Western NY"
.AddItem "Western PA"
End With
Case Is = 2
With cmbDistrict
.AddItem "Centrl Illinois"
.AddItem "Chicago"
.AddItem "Detroit"
.AddItem "Gateway"
.AddItem "Greatr Indiana"
.AddItem "Greatr Michigan"
.AddItem "Lakeland"
End With
Case Is = 3
With cmbDistrict
.AddItem "Finance SSC"
.AddItem "Operations SSC"
End With
Case Is = 4
With cmbDistrict
.AddItem "Albany"
.AddItem "Caribbean"
.AddItem "Conn Valley"
.AddItem "Greater Boston"
.AddItem "Long Island"
.AddItem "New York"
.AddItem "No New England"
.AddItem "Northern NJ"
.AddItem "Triboro"
.AddItem "Westchester"
End With
Case Is = 5
With cmbDistrict
.AddItem "Bay-Valley"
.AddItem "Honolulu"
.AddItem "Los Angeles"
.AddItem "Sacramento"
.AddItem "San Diego"
.AddItem "San Francisco"
.AddItem "Santa Ana"
.AddItem "Sierra Coastal"
End With
Case Is = 6
With cmbDistrict
.AddItem "Alabama"
.AddItem "Arkansas"
.AddItem "Dallas"
.AddItem "Fort Worth"
.AddItem "Gulf Atlantic"
.AddItem "Houston"
.AddItem "Louisiana"
.AddItem "Mississippi"
.AddItem "Oklahoma"
.AddItem "Rio Grande"
.AddItem "South Florida"
.AddItem "Suncoast"
End With
Case Is = 7
With cmbDistrict
.AddItem "Alaska"
.AddItem "Arizona"
.AddItem "Central Plains"
.AddItem "Colorado Wyoming"
.AddItem "Dakotas"
.AddItem "Hawkeye"
.AddItem "Mid-America"
.AddItem "Nevada -Sierra"
.AddItem "Northland"
.AddItem "Portland"
.AddItem "Salt Lake City"
.AddItem "Seattle"
End With
End Select
End Sub
Private Sub cmdRescAttach_Click()
Dim strFilename As Variant
ChDir "C:\" ' change to path to start dialog in
strFilename = Application.GetOpenFilename(, , "Choose file for Escalation", , False)
If TypeName(strFilename) = "String" Then
tbRescDocAttached.Value = strFilename
Else
MsgBox "No attachment selected"
End If
End Sub
Private Sub cmdSeniorityRoster_Click()
Dim strFilename As Variant
ChDir "C:\" ' change to path to start dialog in
strFilename = Application.GetOpenFilename(, , "Choose file for Escalation", , False)
If TypeName(strFilename) = "String" Then
tbRSCDocAttached.Value = strFilename
Else
MsgBox "No attachment selected"
End If
End Sub
Private Sub cmdUHAAttach_Click()
Dim strFilename As Variant
ChDir "C:\" ' change to path to start dialog in
strFilename = Application.GetOpenFilename(, , "Choose file for Escalation", , False)
If TypeName(strFilename) = "String" Then
tbUHADocAttached.Value = strFilename
Else
MsgBox "No attachment selected"
End If
End Sub
Private Sub FeedbackButton_Click()
FeedbackForm.Show
Unload EscalationsForm
End Sub
Private Sub ProcessingTimeGuidelines_Click()
Const szhttp As String = "http://"
' Grab the labels caption because it contains the actual
' address of where we are heading...
Dim szWebsite As String
szWebsite = Me.lblNavigate.Caption
' Tie the constant and the caption into a valid address
Dim szValidWebPath As String
szValidWebPath = szhttp & szWebsite
' Navigate to the address...
ThisWorkbook.FollowHyperlink szValidWebPath
' *Must unload form to avoid Excel freeze up
Unload Me
End Sub
Private Sub tbOriginalSubmissionDate_AfterUpdate()
'Data Validation for Date Format
If tbOriginalSubmissionDate.Value = "" Then
MsgBox "No date entered."
Exit Sub
Else
If Not IsDate(tbOriginalSubmissionDate.Value) Then
MsgBox "Invalid date entered"
Exit Sub
End If
End If
If CDate(tbOriginalSubmissionDate.Value) > Date Then
MsgBox "The date entered is in the future. Please enter a past date."
End If
End Sub
Private Sub UserForm_Initialize()
'Makes the First page of the Multipage Visible upon opening the form
Me.MultiPage1.Value = 0
Me.tbTodaysDate = Date
'fill combobox from Validation List (futureproof)
For Each cell In [District]
Me.cmbDistrict.AddItem cell
Next cell
For Each cell In [Escalation_Type]
Me.cmbEscalation_Type.AddItem cell
Next cell
For Each cell In [RescRequestedAction]
Me.cmbRescRequestedAction.AddItem cell
Next cell
For Each cell In [IntRVacancies]
Me.cmbIntRVacancies.AddItem cell
Next cell
For Each cell In [IntRRejectedReason]
Me.cmbIntRRejectedReason.AddItem cell
Next cell
For Each cell In [RSCCraft]
Me.cmbRSCCurrentCraft.AddItem cell
Next cell
For Each cell In [RSCCraft]
Me.cmbRSCExpectedCraft.AddItem cell
Next cell
For Each cell In [CeJPRR2Cancel]
Me.cmbCeJPRR2Cancel.AddItem cell
Next cell
For Each cell In [UHAForms]
Me.cmbUHAForms.AddItem cell
Next cell
For Each cell In [RSCReason]
Me.cmbRSCReason.AddItem cell
Next cell
For Each cell In [CRSTSupportTeamRoles]
Me.cmbCRSTSupportAdd.AddItem cell
Next cell
For Each cell In [CRSTSupportTeamRoles]
Me.cmbCRSTSupportRem.AddItem cell
Next cell
For Each cell In [RescReason]
Me.cmbRescReason.AddItem cell
Next cell
'Dependant combobox for Area-District Selection
With cmbArea
.AddItem "Capital Metro"
.AddItem "Eastern"
.AddItem "Great Lakes"
.AddItem "Headquarters"
.AddItem "Northeast"
.AddItem "Pacific"
.AddItem "Southern"
.AddItem "Western"
End With
'Dependant combobox for Correction Types Selection
With cmbF50CorrectionTypeMain
.AddItem "Correction to Hire Action (Enter on Duty Date)"
.AddItem "Form 50 Action Correction"
.AddItem "Other"
End With
'Passing Windows Environmental Data
Dim User As String
Dim User2 As String
User = Application.Username
User2 = Environ("UserName")
'Default Values to Display in the Input Fields At Load and Max Length Code
cmbEscalation_Type.Value = "Please Make A Selection..."
tbSubmitterEmail.Value = User2
tbSubmitterName.Value = User
cmbF50FinalAction.Value = "ONLY Necessary for Form 50 Action Corrections. Otherwise, DO NOT USE"
tbRSCCurrentRank.Value = "1"
tbeJPRDateSubmitted.Value = "MM/DD/YYYY"
tbOriginalSubmissionDate.Value = "MM/DD/YYYY"
tbF50EffectiveDate.Value = "MM/DD/YYYY"
tbCPHLDate.Value = "MM/DD/YYYY"
tbRSCEffectiveDate.Value = "MM/DD/YYYY"
tbRSCExpectedDate.Value = "MM/DD/YYYY"
tbRSCCurrentDate.Value = "MM/DD/YYYY"
tbUHAEffectiveDate.Value = "MM/DD/YYYY"
tbeJPRPosting.Value = "MM/DD/YYYY"
tbF50EIN.MaxLength = 8
tbF50Position.MaxLength = 8
tbF50Req.MaxLength = 8
tbIntRReq.MaxLength = 8
tbPHLReq.MaxLength = 8
tbRSCBidCluster.MaxLength = 6
tbRSCEINCorrection.MaxLength = 8
tbRSCCurrentRank.MaxLength = 3
tbRescReq.MaxLength = 8
tbUHAReq.MaxLength = 8
tbUHAEIN.MaxLength = 8
tbUHALast4SSN.MaxLength = 4
tbUHAPosition.MaxLength = 8
tbCeJPRReq.MaxLength = 8
tbCRSTReq.MaxLength = 8
tbCRSTEINAdd.MaxLength = 8
tbCRSTEINRem.MaxLength = 8
End Sub
Private Sub cmdSubmitEmail_Click()
'Sets Mandatory Fields
If Me.cmbArea.Value = "" Then
Me.cmbArea.SetFocus
MsgBox "'Area' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
ElseIf Me.cmbDistrict.Value = "" Then
Me.cmbDistrict.SetFocus
MsgBox "'District' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
ElseIf Me.cmbEscalation_Type.Value = "" Then
Me.cmbEscalation_Type.SetFocus
MsgBox "'Escalation/Correction Type' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
ElseIf Me.tbOriginalSubmissionDate.Value = "" Then
Me.tbOriginalSubmissionDate.SetFocus
MsgBox "'Original Submission Date' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
ElseIf Me.tbSubmitterName.Value = "" Then
Me.tbSubmitterName.SetFocus
MsgBox "'Submitter's Name' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
ElseIf Me.tbSubmitterPhone.Value = "" Then
Me.tbSubmitterPhone.SetFocus
MsgBox "'Submitter's Phone #' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
ElseIf Me.tbSubmitterEmail.Value = "" Then
Me.tbSubmitterEmail.SetFocus
MsgBox "'Submitter's Email' is a mandatory field...", vbOKOnly, "Required Field"
ElseIf Me.tbF50Req.Value = "" Then
Me.tbF50Req.SetFocus
MsgBox "'Requisition NB#' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
ElseIf Me.tbIntRReq.Value = "" Then
Me.tbF50Req.SetFocus
MsgBox "'Requisition NB#' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
ElseIf Me.tbPHLReq.Value = "" Then
Me.tbF50Req.SetFocus
MsgBox "'Requisition NB#' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
End If
'Start coding for projecting number of Business Days (Change the "2" to change the number of days.)
Dim DateExpected As Date
DateExpected = WorksheetFunction.WorkDay(Date, 2)
'Submit information to Outlook Email
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "HRSSC External " & EscalationsForm.cmbArea
.CC = ""
.BCC = EscalationsForm.tbSubmitterEmail
.Subject = "Escalation From: " & EscalationsForm.cmbDistrict & " District; " & EscalationsForm.cmbEscalation_Type & " " & EscalationsForm.cmbF50CorrectionTypeMain & " " & EscalationsForm.cmbF50NextAction
.HTMLbody = "The following email is a Receipt of the Escalation you just submitted. The HRSSC will respond to this Escalation by close of business on " & Format(DateExpected, "Long Date") & ".<br><H2>Submission Information:</h2>" & "<b>Date Sent: </b>" & EscalationsForm.tbTodaysDate & "<br><b>Escalation Type: </b>" & EscalationsForm.cmbEscalation_Type & "<br><b>Area: </b>" & EscalationsForm.cmbArea & "<br><b>District: </b>" & EscalationsForm.cmbDistrict & "<br><br><b>Submitter's Name: </b>" & EscalationsForm.tbSubmitterName & "<br><b>Phone: </b>" & EscalationsForm.tbSubmitterPhone & "<br><b>E-mail/ACE ID: </b>" & EscalationsForm.tbSubmitterEmail _
& "<br><h3><font color=blue>Escalation to Rescind Offers:</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbRescReq & " - " & EscalationsForm.tbRescReqTitle & "<br><b>Applicant's Name: </b>" & EscalationsForm.tbRescApplicantName & "<br><b>Description: </b>" & EscalationsForm.tbRescDescription & "<br><b>Requested Action: </b>" & EscalationsForm.cmbRescRequestedAction _
& "<br><h3><font color=blue>Escalation for Correction to Support Team (Requisition and/or eJPR):</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbCRSTReq & " - " & EscalationsForm.tbCRSTReqTitle & "<br>" & "<h4>Please Add The Following Information:</h4>" & "<b>Name: </b>" & EscalationsForm.tbCRSTNameAdd & "<br><b>EIN: </b>" & EscalationsForm.tbCRSTEINAdd & "<br><b>Support Team Role: </b>" & EscalationsForm.cmbCRSTSupportAdd & "<br>" & "<h4>Please Remove The Following Information:</h4>" & "<b>Name: </b>" & EscalationsForm.tbCRSTNameRem & "<br><b>EIN: </b>" & EscalationsForm.tbCRSTEINRem & "<br><b>Support Team Role: </b>" & EscalationsForm.cmbCRSTSupportRem & "<br><br><b>Additional Details: </b>" & EscalationsForm.tbCRSTAdditional _
& "<br><h3><font color=blue>Escalation for eJPR Correction/Second Request/Request to Cancel Posting:</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbCeJPRReq & " - " & EscalationsForm.tbCeJPRReqTitle & "<h4>Option Chosen (TRUE = Change Requested; FALSE = No Change Needed):</h4>" & "<br><b>Contact Information: </b>" & EscalationsForm.chkeJPRContact & "<br>" & EscalationsForm.tbeJPRContact & "<br><b>Location: </b>" & EscalationsForm.chkeJPRLocation & "<br>" & EscalationsForm.tbeJPRLocation & "<br><b>Posting Date: </b>" & EscalationsForm.chkeJPRPosting & "<br>" & EscalationsForm.tbeJPRPosting & "<br><b>Requisition Title: </b>" & EscalationsForm.chkeJPRRequisition _
& EscalationsForm.tbeJPRRequisition & "<br>" & "<h4>eJPR Not Released:</h4><b>Date eJPR Submitted: </b>" & EscalationsForm.tbeJPRDateSubmitted & "<br>" & "<h4>Request to Cancel Posting:</h4><b>Reason for Cancellation: </b>" & EscalationsForm.cmbCeJPRR2Cancel & "<br><br><b>Additional Details: </b>" & EscalationsForm.tbCeJPRAdditional _
& "<br><h3><font color=blue>Escalation for Pre-Hire List Correction:</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbPHLReq & " - " & EscalationsForm.tbPHLReqTitle & "<br><h4>Which Option Describes Your Issue?</h4><b>Late Initial Pre-Hire List: </b>" & EscalationsForm.opCPHLLatePHL & "<br><b>Pre-Hire List Does Not Include All Applicants Originally Requested: </b>" & EscalationsForm.opCPHLMissing & "<br><b>Late Subsequent Pre-Hire List: </b>" & EscalationsForm.opCPHLLateSubPHL & "<br><b>If True, Date Requested: </b>" & EscalationsForm.tbCPHLDate & "<br><br><b>Additional Details: </b>" & EscalationsForm.tbPHLAdditional _
& "<br><h3><font color=blue>Escalation for Interview Results:</h3></font>" & "<b>Requisition Information: </b>NB" & EscalationsForm.tbIntRReq & " - " & EscalationsForm.tbIntRReqTitle & "<h4>Which Option Best Describes Your Issue:</h4><b>Interview Results Submitted - Selections and Offers Have Not Been Made: </b>" & EscalationsForm.opIntROffersNotMade & "<br><br><b>Selections Not Made According to Selecting Officials/Interviewer's Expectations: </b>" & EscalationsForm.opIntRIncorrectSelections & "<br><b>If True, Details: </b>" & EscalationsForm.tbIntRDetails & "<br><br><b>Incorrect Number of Vacancies Filled: </b>" & EscalationsForm.opIntRVacanciesFilled & "<br><b>If True, Correct Number of Vacancies: </b>" & EscalationsForm.tbIntRCorrectVacancies & "<br><b>If True, Reason Vacancies Changed: </b>" & EscalationsForm.cmbIntRVacancies & "<br><br><b>Application Rejected in Error: </b>" & EscalationsForm.opIntRRejectedInError _
& "<br><b>Applicant's Name: </b>" & EscalationsForm.tbIntRApplicantNameRej & "<br><b>Reason Rejected in Error: </b>" & EscalationsForm.cmbIntRRejectedReason & "<br><br><b>Additional Comments/Details: </b>" & EscalationsForm.tbIntRAdditional _
& "<br><h3><font color=blue>Escalation for Unprocessed Hire Actions:</h3></font><h4>Applicant Details:</h4><b>Applicant's Name: </b>" & EscalationsForm.tbUHAApplicantName & "<br><b>Requisition #: </b>" & EscalationsForm.tbUHAReq & "<br><b>Applicant's EIN: </b>" & EscalationsForm.tbUHAEIN & "<br><b>Last 4 of Applicant's SSN: </b>" & EscalationsForm.tbUHALast4SSN & "<br><b>Applicant's Position #: </b>" & EscalationsForm.tbUHAPosition & "<br><b>Applicant's Effective Date: </b>" & EscalationsForm.tbUHAEffectiveDate & "<br><b>Which Form Are You Attaching to Correct: </b>" & EscalationsForm.cmbUHAForms _
& "<br><h3><font color=blue>Escalation for Form 50 Corrections:</h3></font><h4>Employee's Details:</h4><b>Employee's Name: </b>" & EscalationsForm.tbF50ApplicantName & "<br><b>Requisition #: </b>NB" & EscalationsForm.tbF50Req & "<br><b>Employee's EIN: </b>" & EscalationsForm.tbF50EIN & "<br><b>Position #: </b>" & EscalationsForm.tbF50Position & "<br><b>Employee's Effective Date: </b>" & EscalationsForm.tbF50EffectiveDate & "<br><br><b>Primary Action: </b>" & EscalationsForm.cmbF50CorrectionTypeMain & "<br><b>Secondary Action: </b>" & EscalationsForm.cmbF50NextAction & "<br><b>Final Action, If Needed: </b>" & EscalationsForm.cmbF50FinalAction & "<br><br><b>Additional Details: </b>" & EscalationsForm.tbF50Additional _
& "<br><h3><font color=blue>Escalation for Relative Standing Correction:</h3></font><b>Bid Cluster: </b>BC" & EscalationsForm.tbRSCBidCluster & "<br><b>Effective Date: </b>" & EscalationsForm.tbRSCEffectiveDate & "<br><b>Applicant's Name: </b>" & EscalationsForm.tbRSCNameCorrection & "<br><b>EIN: </b>" & EscalationsForm.tbRSCEINCorrection & "<h4>Corrections</h4><b>Current Seniority Info: <br>Date: </b>" & EscalationsForm.tbRSCCurrentDate & "<b>Rank: </b>" & EscalationsForm.tbRSCCurrentRank & "<b>Craft: </b>" & EscalationsForm.cmbRSCCurrentCraft & "<br><br><b>Expected Seniority Info: <br>Date: </b>" & EscalationsForm.tbRSCExpectedDate & "<b>Rank: </b>" & EscalationsForm.tbRSCExpectedRank & "<b>Craft: </b>" & EscalationsForm.cmbRSCExpectedCraft _
& "<h4>Initial Calculation</h4><b>Please Select The Crafts That Require Calculation:<br><br>City Carrier Assistants: </b>" & EscalationsForm.chkRSCCraftCA & "<br><b>PSE Clerks: </b>" & EscalationsForm.chkRSCCraftCK & "<br><b>Mail Handler Assistants: </b>" & EscalationsForm.chkRSCCraftMH & "<br><b>PSE Maintenance: </b>" & EscalationsForm.chkRSCCraftMN & "<br><b>PSE Motor Vehicle Services: </b>" & EscalationsForm.chkRSCCraftMV & "<br><b>Rural Carrier Assistants: </b>" & EscalationsForm.chkRSCCraftRU & "<br><br><b>Reason for the Request: </b>" & EscalationsForm.cmbRSCReason & "<br><br><b>Additional Comments/Details: </b>" & EscalationsForm.tbRSCAdditional
.Display
' .Send 'or use .Display
.Attachments.Add EscalationsForm.tbRescDocAttached.Value & EscalationsForm.tbUHADocAttached.Value & EscalationsForm.tbRSCDocAttached.Value
If tbRescDocAttached.Value <> "" Then
.Attach tbRescDocAttached.Value
ElseIf tbUHADocAttached.Value <> "" Then
.Attach tbUHADocAttached.Value
ElseIf tbRSCDocAttached.Value <> "" Then
.Attach tbRSCAttached.Value
End If
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Thank you for your submission! An email containing the information you submitted has been sent to the address listed."
Unload EscalationsForm
'Submit information to Escalations Table
Dim Escalations As Worksheet
Set Escalations = ThisWorkbook.Sheets("Escalations")
nr = Escalations.Cells(Rows.Count, 1).End(xlUp).Row + 1
Escalations.Cells(nr, 1) = Me.tbTodaysDate
Escalations.Cells(nr, 2) = tbOriginalSubmissionDate
Escalations.Cells(nr, 3) = cmbArea
Escalations.Cells(nr, 4) = cmbDistrict
Escalations.Cells(nr, 5) = cmbEscalation_Type
Escalations.Cells(nr, 6) = tbSubmitterName
Escalations.Cells(nr, 7) = tbSubmitterPhone
Escalations.Cells(nr, 8) = tbSubmitterEmail
Escalations.Cells(nr, 9) = tbRescReq
Escalations.Cells(nr, 10) = tbRescReqTitle
Escalations.Cells(nr, 11) = tbRescApplicantName
Escalations.Cells(nr, 12) = tbRescDescription
Escalations.Cells(nr, 13) = cmbRescRequestedAction
Escalations.Cells(nr, 14) = cmbRescReason
Escalations.Cells(nr, 15) = tbCRSTReq
Escalations.Cells(nr, 16) = tbCRSTReqTitle
Escalations.Cells(nr, 17) = tbCRSTNameAdd
Escalations.Cells(nr, 18) = tbCRSTEINAdd
Escalations.Cells(nr, 19) = cmbCRSTSupportAdd
Escalations.Cells(nr, 20) = tbCRSTNameRem
Escalations.Cells(nr, 21) = tbCRSTEINRem
Escalations.Cells(nr, 22) = cmbCRSTSupportRem
Escalations.Cells(nr, 23) = tbCRSTAdditional
Escalations.Cells(nr, 24) = tbCeJPRReq
Escalations.Cells(nr, 25) = tbCeJPRReqTitle
Escalations.Cells(nr, 26) = chkeJPRContact
Escalations.Cells(nr, 27) = tbeJPRContact
Escalations.Cells(nr, 28) = chkeJPRLocation
Escalations.Cells(nr, 29) = tbeJPRLocation
Escalations.Cells(nr, 30) = chkeJPRPosting
Escalations.Cells(nr, 31) = tbeJPRPosting
Escalations.Cells(nr, 32) = chkeJPRRequisition
Escalations.Cells(nr, 33) = tbeJPRRequisition
Escalations.Cells(nr, 34) = tbeJPRDateSubmitted
Escalations.Cells(nr, 35) = cmbCeJPRR2Cancel
Escalations.Cells(nr, 36) = tbCeJPRAdditional
Escalations.Cells(nr, 37) = tbPHLReq
Escalations.Cells(nr, 38) = tbPHLReqTitle
Escalations.Cells(nr, 39) = opCPHLLatePHL
Escalations.Cells(nr, 40) = opCPHLMissing
Escalations.Cells(nr, 41) = opCPHLLateSubPHL
Escalations.Cells(nr, 42) = tbCPHLDate
Escalations.Cells(nr, 43) = tbPHLAdditional
Escalations.Cells(nr, 44) = tbIntRReq
Escalations.Cells(nr, 45) = tbIntRReqTitle
Escalations.Cells(nr, 46) = opIntROffersNotMade
Escalations.Cells(nr, 47) = opIntRIncorrectSelections
Escalations.Cells(nr, 48) = tbIntRDetails
Escalations.Cells(nr, 49) = opIntRVacanciesFilled
Escalations.Cells(nr, 50) = tbIntRCorrectVacancies
Escalations.Cells(nr, 51) = cmbIntRVacancies
Escalations.Cells(nr, 52) = opIntRRejectedInError
Escalations.Cells(nr, 53) = tbIntRApplicantNameRej
Escalations.Cells(nr, 54) = cmbIntRRejectedReason
Escalations.Cells(nr, 55) = tbIntRAdditional
Escalations.Cells(nr, 56) = tbUHAApplicantName
Escalations.Cells(nr, 57) = tbUHAReq
Escalations.Cells(nr, 58) = tbUHAEIN
Escalations.Cells(nr, 59) = tbUHALast4SSN
Escalations.Cells(nr, 60) = tbUHAPosition
Escalations.Cells(nr, 61) = tbUHAEffectiveDate
Escalations.Cells(nr, 62) = cmbUHAForms
Escalations.Cells(nr, 63) = tbUHAAdditional
Escalations.Cells(nr, 64) = tbF50ApplicantName
Escalations.Cells(nr, 65) = tbF50Req
Escalations.Cells(nr, 66) = tbF50EIN
Escalations.Cells(nr, 67) = tbF50Position
Escalations.Cells(nr, 68) = tbF50EffectiveDate
Escalations.Cells(nr, 69) = cmbF50CorrectionTypeMain
Escalations.Cells(nr, 70) = cmbF50NextAction
Escalations.Cells(nr, 71) = cmbF50FinalAction
Escalations.Cells(nr, 72) = tbF50Additional
Escalations.Cells(nr, 73) = tbRSCBidCluster
Escalations.Cells(nr, 74) = tbRSCEffectiveDate
Escalations.Cells(nr, 75) = tbRSCNameCorrection
Escalations.Cells(nr, 76) = tbRSCEINCorrection
Escalations.Cells(nr, 77) = tbRSCCurrentDate
Escalations.Cells(nr, 78) = tbRSCCurrentRank
Escalations.Cells(nr, 79) = tbRSCCurrentCraft
Escalations.Cells(nr, 80) = tbRSCExpectedDate
Escalations.Cells(nr, 81) = tbRSCExpectedRank
Escalations.Cells(nr, 82) = tbRSCExpectedCraft
Escalations.Cells(nr, 83) = chkRSCCraftCA
Escalations.Cells(nr, 84) = chkRSCCraftCK
Escalations.Cells(nr, 85) = chkRSCCraftMH
Escalations.Cells(nr, 86) = chkRSCCraftMN
Escalations.Cells(nr, 87) = chkRSCCraftMV
Escalations.Cells(nr, 88) = chkRSCCraftRU
Escalations.Cells(nr, 89) = cmbRSCReason
Escalations.Cells(nr, 90) = tbRSCAdditional
End Sub
Private Sub cmbF50CorrectionTypeMain_Change()
'Code For Loading F50 Corrections Combobox Based on Entry from Area Combobox
Dim index As Integer
index = cmbF50CorrectionTypeMain.ListIndex
cmbF50NextAction.Clear
Select Case index
Case Is = 0
With cmbF50NextAction
.AddItem "Cancel Hire Action, No Further Action."
.AddItem "Cancel Hire Action and Correct To New Hire Date"
.AddItem "Cancel Hire Action And Correct to Different Craft; Same Hire Date"
.AddItem "Cancel Hire Action And Correct to Different Craft; Different Hire Date"
End With
Case Is = 1
With cmbF50NextAction
.AddItem "PA2300 Break In Service"
.AddItem "PSE-to-PSE 1-Day Break In Service"
.AddItem "PA2100 External Hiring Worksheet (Non-Competitive)"
.AddItem "PA2100-H Holiday Hire"
End With
Case Is = 2
With cmbF50NextAction
.AddItem "Correction to Position # - No Craft Change"
.AddItem "Finance Number Corrections"
.AddItem "Grievances/Settlements"
.AddItem "Name Correction (e.g. Spelling, Not Legal Name Change, etc.)"
.AddItem "Social Security Number Corrections"
.AddItem "Other"
End With
End Select
End Sub
Private Sub cmbF50NextAction_Change()
'Code For Loading F50 Corrections Combobox Based on Entry from Area Combobox
Dim hireindex As Integer
hireindex = cmbF50NextAction.ListIndex
cmbF50FinalAction.Clear
Select Case hireindex
Case Is = "0"
With cmbF50FinalAction
.AddItem "Testing, Testing"
End With
Case Is = "1"
With cmbF50FinalAction
.AddItem ""
End With
Case Is = "2"
With cmbF50FinalAction
.AddItem ""
End With
Case Is = "3"
With cmbF50FinalAction
.AddItem ""
End With
End Select
Dim f50index As Integer
f50index = cmbF50NextAction.ListIndex
cmbF50FinalAction.Clear
Select Case f50index
Case Is = "0"
With cmbF50FinalAction
.AddItem "Cancel Current Separation/Rehire Actions and Correct To New Dates"
.AddItem "Cancel Current Separation/Rehire Actions; Employee To Remain Active In Previous Job"
.AddItem "Cancel Hire Date Only; Employee To Remain Separated"
.AddItem "Other"
End With
Case Is = 1
With cmbF50FinalAction
.AddItem "Cancel Current Separation and Rehire Actions; Employee Date Change"
.AddItem "Cancel Both Separation and Rehire Actions; Employee To Remain in Previous Position"
.AddItem "Cancel Hire Action Only; Employee To Remain Separated"
.AddItem "Other"
End With
Case Is = 2
With cmbF50FinalAction
.AddItem "Cancel Current Hire Action and Correct to New Hire Date"
.AddItem "Cancel Current Hire Action; No Further Action."
.AddItem "Cancel Current Hire Action and Correct to Different Craft"
.AddItem "Other"
End With
Case Is = 3
With cmbF50FinalAction
.AddItem "Cancel Current Hire Action and Correct to New Hire Date"
.AddItem "Cancel Current Hire Action; No Further Action."
.AddItem "Cancel Current Hire Action and Correct to Different Craft"
.AddItem "Other"
End With
End Select
End Sub
Private Sub tbF50Req_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter the numbers after the NB."
End If
End Sub
Private Sub tbF50EIN_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbF50Position_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbIntRReq_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter the numbers after the NB."
End If
End Sub
Private Sub tbIntRCorrectVacancies_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbPHLReq_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter the numbers after the NB."
End If
End Sub
Private Sub tbRSCBidCluster_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please enter only numbers. This should be the Bid Cluster (BC#) for your Installation."
End If
End Sub
Private Sub tbRSCCurrentRank_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbRSCExpectedRank_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbRSCEINCorrection_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbRescReq_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter the numbers after the NB."
End If
End Sub
Private Sub tbUHAReq_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbUHAEIN_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbUHALast4SSN_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbUHAPosition_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbCeJPRReq_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter the numbers after the NB."
End If
End Sub
Private Sub tbCRSTReq_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter the numbers after the NB."
End If
End Sub
Private Sub tbCRSTEINAdd_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbCRSTEINRem_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0 ' keeps non-numeric data from showing up in the TextBox
MsgBox "Please only enter numbers"
End If
End Sub
Private Sub tbeJPRDateSubmitted_AfterUpdate()
'Data Validation for Date Format
If tbeJPRDateSubmitted.Value = "" Then
MsgBox "No date entered."
Exit Sub
Else
If Not IsDate(tbeJPRDateSubmitted.Value) Then
MsgBox "Invalid date entered"
Exit Sub
End If
End If
End Sub
Private Sub tbF50EffectiveDate_AfterUpdate()
'Data Validation for Date Format
If tbF50EffectiveDate.Value = "" Then
MsgBox "No date entered."
Exit Sub
Else
If Not IsDate(tbF50EffectiveDate.Value) Then
MsgBox "Invalid date entered"
Exit Sub
End If
End If
End Sub
Private Sub tbCPHLDate_AfterUpdate()
'Data Validation for Date Format
If tbCPHLDate.Value = "" Then
MsgBox "No date entered."
Exit Sub
Else
If Not IsDate(tbCPHLDate.Value) Then
MsgBox "Invalid date entered"
Exit Sub
End If
End If
End Sub
Private Sub tbRSCEffectiveDate_AfterUpdate()
'Data Validation for Date Format
If tbRSCEffectiveDate.Value = "" Then
MsgBox "No date entered."
Exit Sub
Else
If Not IsDate(tbRSCEffectiveDate.Value) Then
MsgBox "Invalid date entered"
Exit Sub
End If
End If
End Sub
Private Sub tbRSCExpectedDate_AfterUpdate()
'Data Validation for Date Format
If tbRSCExpectedDate.Value = "" Then
MsgBox "No date entered."
Exit Sub
Else
If Not IsDate(tbRSCExpectedDate.Value) Then
MsgBox "Invalid date entered"
Exit Sub
End If
End If
End Sub
Private Sub tbRSCCurrentDate_AfterUpdate()
'Data Validation for Date Format
If tbRSCCurrentDate.Value = "" Then
MsgBox "No date entered."
Exit Sub
Else
If Not IsDate(tbRSCCurrentDate.Value) Then
MsgBox "Invalid date entered"
Exit Sub
End If
End If
End Sub
Private Sub tbUHAEffectiveDate_AfterUpdate()
'Data Validation for Date Format
If tbUHAEffectiveDate.Value = "" Then
MsgBox "No date entered."
Exit Sub
Else
If Not IsDate(tbUHAEffectiveDate.Value) Then
MsgBox "Invalid date entered"
Exit Sub
End If
End If
End Sub
Private Sub tbeJPRPosting_AfterUpdate()
'Data Validation for Date Format
If tbeJPRPosting.Value = "" Then
MsgBox "No date entered."
Exit Sub
Else
If Not IsDate(tbeJPRPosting.Value) Then
MsgBox "Invalid date entered"
Exit Sub
End If
End If
End Sub
Display More
Thanks for the help thus far...
Re: Userform: Required Fields on Active Multipage Only
Hello RoyUK...sorry if I'm making this more complicated. I'm just trying to convey the issue without giving out sensitive information.
I check for required fields using the following Looped If Else statement:
If Me.tbName.Value = "" Then
Me.tbName.SetFocus
MsgBox "'Name' is a mandatory field...", vbOKOnly, "Required Field"
Exit Sub
ElseIf Me.tbEmail.Value = "" Then
Me.tbEmail.SetFocus
MsgBox "'Email' is a mandatory field...", vbOKOnly, "Required Field"
I then use the
to start the Required field check, send the email using
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = EmailAddress[at]email.com"
.CC = ""
.BCC = tbEmail
.Subject = "Testing Subject
.HTMLbody = "Info goes here"
Display More
And send the information to a table in the worksheet:
Dim Sheet2 As Worksheet
Set Sheet2 = ThisWorkbook.Sheets("Sheet2")
nr = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheet2.Cells(nr, 1) = tbName
Sheet2.Cells(nr, 2) = tbEmail
I can add the above loop to all the fields, but then, on the Click Event for the submit button, it's going to tell me that they are empty which, of course, they are, but by design.
Re: Userform: Required Fields on Active Multipage Only
Page 1, Filled Out.
[ATTACH=CONFIG]69135[/ATTACH]
Sample Workbook attached.
forum.ozgrid.com/index.php?attachment/69136/
Re: Userform: Required Fields on Active Multipage Only
My apologies RoyUK. A lot of the populated fields is proprietary and/or sensitive so I can't put up the workbook code. Instead, I made a quick sample just to give you an idea. I hope this works.
On the main portion of the form, there are three fields (All Required Fields). A TextBox for Name, a TextBox for Email, and a ComboBox with three choices.
Private Sub UserForm_Initialize()
'Populates Combobox
With ComboBox1
.AddItem "Page 1"
.AddItem "Page 2"
.AddItem "Page 3"
End With
End Sub
On Page 1 of the MultiPage1, there are three Text Boxes. A TextBox for SSN (Required), a TextBox for Date (Required), and a Multiline TextBox for Details (Not Required).
[ATTACH=CONFIG]69133[/ATTACH]
On Page 2 of the MultiPage1, there are three Text Boxes. A TextBox for Height (Required), a TextBox for Weight, and a Multiline TextBox for Details (Required).
[ATTACH=CONFIG]69134[/ATTACH]
(I just included Page 3 as blank..but there would be input fields there too with mixes of Required and Not Required)
The Selection in ComboBox1 determines which Page of the Userform is active with the following code:
Private Sub ComboBox1_Change()
'Changes Multipage based on ComboBox1 selection
With Me
.MultiPage1.Value = .ComboBox1.ListIndex
End With
End Sub
The user will ALWAYS only be filling out one page of information.
When the form is submitted, it sends the information to a table and submits the results via Outlook. In the example, I have filled out all of the information in Page1. However, I can't submit the form because of the Required Fields on Page 2 for 'Height' and 'Details'.
I would like to make the Userform so that when I select Page 1, only the required fields on that page are required for submission. I want it to treat the fields on Page 2 as non-required, unless I activate Page 2 by selecting that option in Combobox1.
I hope this clarifies...sorry I couldn't give more code.
Hello everyone,
I can't wait until I am one of the experts answering these questions instead of one of the novice members posting them!
I have a Userform that contains a Multipage object. I've coded the Multipage so that the page that is active is linked to the selection in a combobox using the ListIndex property. And I have 6 fields in the top (not on the multipage) that are common to each submission that are required and work perfectly.
What I would like to do is to make all of the fields only on the currently active Multipage required but leave the fields on the inactive Multipages as not required. The required fields would need to switch if a new page is activated with a new selection from the combobox.
Hopefully I'm being clear enough. But please let me know if you need clarification. Thanks, in advance for any help provided!
Re: 2 Business Days from date entered
Thank you skywriter!
That worked perfectly! Since we are solely US-based, I think I can put off worry about Weekends being set differently.
Thanks, again!
Good morning all,
VBA Novice here!
I'm making a userform that returns an email using the "With Outmail" with statement to send .HTMLbody code as a message. In the first line of the subject, I want to inform the submitter that we will respond to their request by close of business on the 2nd business day from the submission date. However, the current "code" I used doesn't account properly for business days.
Can anyone help me modify the code so that it accounts for business days? This is part of the Click event procedure for a "Submit" button where "tbTodaysDate" is a locked text box field that auto-populates today's date..
Dim LDate As Date
LDate = DateAdd("d", 2, EscalationsForm.tbTodaysDate.Value)
'More Coding for the outlook email
'Picks up here
With OutMail
.HTMLbody = "We will respond to this Escalation by close of business on " & Format(LDate, "Long Date") & "."
Display More
Any help is greatly appreciated as I've seen some answers using functions but I don't know how to properly deploy them, nor do I understand what they are doing.