HiFolks,
I'm trying to create a userform that will checkto see if information related to the current row had already been recorded to a different worksheet (Worksheet1 is the active one, worksheet3 holds the information),and pre-populate the checkmarks on a multi-select option listbox with information if it already had been added to a secondary worksheet. Then, once the user hadupdated the form, and pressed the update button, it would export thatinformation into worksheet 3.
Basically what I have is that certain job typesrequire extra processing, and I want to use a userform to create a checklist ofprocesses that need to be performed before the job is complete. Steps that arenot required for other types of jobs.
My pseudo code thinking:
When the userform is opened, it pulls in the job# of the current row (which is in colA of sheet 1).
if userform job# = job# field in column A ofworksheet3 (also job#) then populate the checkboxes with the values foundin columns B-N (which correspond to the checklist boxes in the userform)
User updates the checkboxes (amulti-select listbox with options, which populates from a named range on sheet2), and then clicks the "Update" button - which triggers the form tofill the columns with data (or overwrite as need). User clicks the "CloseForm" button, which exits the form.
Else add new row to bottom of Mailing Jobsworksheet (Sheet3) and fill with the check box values when the user clicks"Update". User clicks the "Close Form" button, which exitsthe form.
If col M = "Ready to Deliver", removecorresponding line from the Mailing Jobs worksheet (this I think get's added tomy existing code surrounding col M event changes)
I'm using a form control button on sheet1 to trigger the Userform (MailingTaskList). The Userform has a text box (JobNumber), the multiselect option listbox (MailingCheckList), and two command buttons (UpdateForm and CloseForm).
Here's what I have for code at present whichobviously doesn't do everything above. It will add a line to the secondary worksheet, and exports the label of the chosen option from the checklist (I'd rather it just said T/F or Y/N, as there is a header in my sheet). It doesn't get far enough to check forprevious iterations, let alone bring in information that it might find there.
I've been plugging away at this for some time, and am hoping someone can point me in the right direction? Or show/explain what needs to happen here?
My code for the Userform:
There are many things in my Sheet1, provided to help prevent interactions:
And a few calls in my ThisWorkbook, again provided to prevent interactions:
I'm trying to create a userform that will checkto see if information related to the current row had already been recorded to a different worksheet (Worksheet1 is the active one, worksheet3 holds the information),and pre-populate the checkmarks on a multi-select option listbox with information if it already had been added to a secondary worksheet. Then, once the user hadupdated the form, and pressed the update button, it would export thatinformation into worksheet 3.
Basically what I have is that certain job typesrequire extra processing, and I want to use a userform to create a checklist ofprocesses that need to be performed before the job is complete. Steps that arenot required for other types of jobs.
My pseudo code thinking:
When the userform is opened, it pulls in the job# of the current row (which is in colA of sheet 1).
if userform job# = job# field in column A ofworksheet3 (also job#) then populate the checkboxes with the values foundin columns B-N (which correspond to the checklist boxes in the userform)
User updates the checkboxes (amulti-select listbox with options, which populates from a named range on sheet2), and then clicks the "Update" button - which triggers the form tofill the columns with data (or overwrite as need). User clicks the "CloseForm" button, which exits the form.
Else add new row to bottom of Mailing Jobsworksheet (Sheet3) and fill with the check box values when the user clicks"Update". User clicks the "Close Form" button, which exitsthe form.
If col M = "Ready to Deliver", removecorresponding line from the Mailing Jobs worksheet (this I think get's added tomy existing code surrounding col M event changes)
I'm using a form control button on sheet1 to trigger the Userform (MailingTaskList). The Userform has a text box (JobNumber), the multiselect option listbox (MailingCheckList), and two command buttons (UpdateForm and CloseForm).
Here's what I have for code at present whichobviously doesn't do everything above. It will add a line to the secondary worksheet, and exports the label of the chosen option from the checklist (I'd rather it just said T/F or Y/N, as there is a header in my sheet). It doesn't get far enough to check forprevious iterations, let alone bring in information that it might find there.
I've been plugging away at this for some time, and am hoping someone can point me in the right direction? Or show/explain what needs to happen here?
My code for the Userform:
Code:
Private Sub CloseForm_Click()
Unload Me
End Sub
'This segment does nothing, as yet - an attempt to bring in keyboard strokes as event handlers, and populate the checklist options based on previous input - the single quote are parts that I know to work in some fashion, the triples are code that I'm working on from another example
' Private Sub JobNumber_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' If KeyCode = vbKeyReturn Then
'''Dim DataSH As Worksheet
'''Set DataSH = Sheets("MailingJobs")
'''DataSH.Range("A2").Value = JobNumber.Text
'''DataSH.Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, criteriarange:=DataSH.Range("P2:P3"), copytorange:=DataSH.Range("B2:N2")
'''MailingCheckList.RowSource = "MailingJobs" & DataSH.Range("outdata").Address
' Dim FindMe As Variant, FindCell As Range
'With Range("BLANK")
' FindMe = JobNumber
' Set FindCell = .Cells.Find(What:=FindMe, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart _
' , SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
' If Not FindCell Is Nothing Then
'''tbxBlankAccount.Value = FindCell(1, 1).Value
'''tbxBlankName.Value = FindCell(1, 2).Value
'''tbxBlankShort.Value = FindCell(1, 3).Value
' MailingCheckList.Value = ""
' Else
' MsgBox "Search Criteria - " & FindMe & " Was Not Found", vbExclamation
'End If
' End With
'End If
'End Sub
Private Sub UpdateForm_Click()
'this code works to place selected items from list box into sheet7
'it only places data into the next empty row, it does not search and update
Dim i
Dim lRow As Long
Dim emptyRow As Long
Dim lItem As Long
Dim Found As Range
Dim str As String
With Sheets("MailingJobs")
str = Me.JobNumber.Text
Set Found = Worksheets("Sheet7").Range(Worksheets("Sheet7").Range("A2"), Worksheets("Sheet7").Range("A" & Rows.Count).End(xlUp)).Find(str)
'Worksheets("Sheet2").Range(Worksheets("Sheet2"). _
Range("A1"), Worksheets("Sheet2").Range("A7")))
If Found Is Nothing Then
'this segment was working before the if was added to the IF
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(emptyRow, 1).Value = JobNumber.Value
For i = 0 To MailingCheckList.ListCount - 1
If MailingCheckList.Selected(i) Then
.Cells(emptyRow, i + 2) = MailingCheckList.List(lItem)
End If
Next i
Else
MsgBox ("Already There!")
End If 'belongs to the if found is nothing line above
End With
End Sub
There are many things in my Sheet1, provided to help prevent interactions:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)'Update 20160721
Dim WorkRng As Range
Dim rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("M:M"), Target)
xOffsetColumn = 3
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
'If the value of M toggles to Approved/Ready to Print, place the date in Changes (N)
If rng.Value = "Approved" Then
rng.Offset(, 1).Value = Now
rng.Offset(, 1).NumberFormat = "dd mmm"
ThisWorkbook.Save
End If
If rng.Value = "Ready to Print" Then
rng.Offset(, 1).Value = Now
rng.Offset(, 1).NumberFormat = "dd mmm"
ThisWorkbook.Save
End If
'If the value of M toggles to Proof (any variant), clear the contents of Priority (Q)
If rng.Value = "Proof" Then
rng.Offset(, 4).ClearContents
ThisWorkbook.Save
End If
If rng.Value = "Proof 2" Then
rng.Offset(, 4).ClearContents
ThisWorkbook.Save
End If
If rng.Value = "Proof 3" Then
rng.Offset(, 4).ClearContents
ThisWorkbook.Save
End If
If rng.Value = "Hard Proof" Then
rng.Offset(, 4).ClearContents
ThisWorkbook.Save
End If
If rng.Value = "Hard Proof 2" Then
rng.Offset(, 4).ClearContents
ThisWorkbook.Save
End If
If rng.Value = "Hard Proof 3" Then
rng.Offset(, 4).ClearContents
ThisWorkbook.Save
End If
'If the value of Status (M) toggles to Plated, save the workbook
If rng.Value = "Plated" Then
ThisWorkbook.Save
End If
'If the value of M toggles to Approved, copy S (next location) into R (current location), and clear priority (Q)
If rng.Value = "Approved" Then
rng.Offset(, 5).Value = Cells(Application.ActiveCell.Row, 19)
rng.Offset(, 4).ClearContents
If rng.Offset(, 2).Value = "trim" Then
rng.Offset(, 6).Value = "Bindery"
End If
If (InStr(1, (rng.Offset(, 2).Value), "to Produce") > 0 Or InStr(1, (rng.Offset(, 2).Value), "to convert") > 0 Or InStr(1, (rng.Offset(, 2).Value), "to Laminate") > 0) And InStr(1, (rng.Offset(, 2).Value), "Epi") = 0 Then
rng.Offset(, 6).Value = "Outside"
End If
If (InStr(1, (rng.Offset(, 2).Value), "to Produce") > 0 Or InStr(1, (rng.Offset(, 2).Value), "to convert") > 0 Or InStr(1, (rng.Offset(, 2).Value), "to Laminate") > 0) And InStr(1, (rng.Offset(, 2).Value), "Epi") > 0 Then
rng.Offset(, 6).Value = "H Assem"
End If
If InStr(1, (rng.Offset(, 2).Value), "die cut") > 0 Then
rng.Offset(, 6).Value = "Die Cut"
End If
If InStr(1, (rng.Offset(, 2).Value), "trim") > 0 And InStr(1, (rng.Offset(, 2).Value), "die cut") = 0 Then
rng.Offset(, 6).Value = "Bindery"
End If
If InStr(1, (rng.Offset(, 2).Value), "trim") > 0 And InStr(1, (rng.Offset(, 2).Value), "die cut") > 0 Then
rng.Offset(, 6).Value = "Die Cut"
End If
If InStr(1, (rng.Offset(, 2).Value), "flat sheets") > 0 Then
rng.Offset(, 6).Value = "Delivery"
End If
If InStr(1, (rng.Offset(, 2).Value), "rebox") > 0 Then
rng.Offset(, 6).Value = "Delivery"
End If
ThisWorkbook.Save
End If
If rng.Value = "Printing X" Then
rng.Offset(, 5).Value = Cells(Application.ActiveCell.Row, 19)
rng.Offset(, 4).ClearContents
If InStr(1, (rng.Offset(, 2).Value), "trim") > 0 Then
rng.Offset(, 6).Value = "Delivery"
End If
If InStr(1, (rng.Offset(, 2).Value), "assemble") > 0 Then
rng.Offset(, 6).Value = "H Assem"
End If
If InStr(1, (rng.Offset(, 2).Value), "assemble") = 0 And InStr(1, (rng.Offset(, 2).Value), "die cut") > 0 Then
rng.Offset(, 6).Value = "Delivery"
End If
ThisWorkbook.Save
End If
If rng.Value = "Production X" Then
rng.Offset(, 5).Value = Cells(Application.ActiveCell.Row, 19)
rng.Offset(, 4).ClearContents
ThisWorkbook.Save
End If
If rng.Value = "Complete" Then
rng.Offset(, 5).Value = Cells(Application.ActiveCell.Row, 19)
rng.Offset(, 4).ClearContents
ThisWorkbook.Save
End If
If rng.Value = "H.Assem. X" Then
rng.Offset(, 5).Value = Cells(Application.ActiveCell.Row, 19)
rng.Offset(, 4).ClearContents
ThisWorkbook.Save
End If
If rng.Value = "Bind X" Then
rng.Offset(, 5).Value = Cells(Application.ActiveCell.Row, 19)
rng.Offset(, 4).ClearContents
If InStr(1, (rng.Offset(, 2).Value), "assemble") > 0 Then
rng.Offset(, 6).Value = "H Assem"
End If
ThisWorkbook.Save
End If
If rng.Value = "Die Cut X" Then
rng.Offset(, 5).Value = Cells(Application.ActiveCell.Row, 19)
rng.Offset(, 4).ClearContents
If InStr(1, (rng.Offset(, 2).Value), "assemble") > 0 Then
rng.Offset(, 6).Value = "Delivery"
End If
ThisWorkbook.Save
End If
If rng.Value = "On Hold" Then
rng.Offset(, 1).Value = Now
rng.Offset(, 1).NumberFormat = "dd mmm"
rng.Offset(, 4).ClearContents
rng.Offset(, 6).Value = Cells(Application.ActiveCell.Row, 18)
rng.Offset(, 5).Value = "Hold"
ThisWorkbook.Save
End If
If Not VBA.IsEmpty(rng.Value) Then
rng.Offset(0, xOffsetColumn).Value = Now
rng.Offset(0, xOffsetColumn).NumberFormat = "dd mmm"
ThisWorkbook.Save
Else
rng.Offset(0, xOffsetColumn).ClearContents
ThisWorkbook.Save
End If
Next
Application.EnableEvents = True
End If
End Sub
And a few calls in my ThisWorkbook, again provided to prevent interactions:
Code:
'DO NOT DELETE!'This section for saving and applying the header to the file
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:06:30"), "SaveThis"
Application.OnTime TimeValue("09:00:00"), "Test"
Application.OnTime TimeValue("19:00:00"), "CloseAllWorkbooks"
Application.OnTime TimeValue("7:01 PM"), "CloseAllWorkbooks"
End Sub