BenjaminLyon
New Member
- Joined
- Jan 13, 2016
- Messages
- 2
Hi Everyone,
I have been reading all this threads to put together my Userform,
Now I have it and it works but it could be better, what my code does is search through orders based on a selection made in a combobox and text entered into a text box. Now it works, however it has glitched in it.
Specifically when I alter the text in the textbox or change the combobox i get nonsense orders returned that don't match my criteria, this is rectified by changing my combobox again usually but i dont want to have to mess around more then i have to. Also I dont always get the full list of available items returned, I believe this has something to do with my ignore strikethrough reference. My Code is as follows;
I have been reading all this threads to put together my Userform,
Now I have it and it works but it could be better, what my code does is search through orders based on a selection made in a combobox and text entered into a text box. Now it works, however it has glitched in it.
Specifically when I alter the text in the textbox or change the combobox i get nonsense orders returned that don't match my criteria, this is rectified by changing my combobox again usually but i dont want to have to mess around more then i have to. Also I dont always get the full list of available items returned, I believe this has something to do with my ignore strikethrough reference. My Code is as follows;
PHP:
Public X As StringPublic Txt As StringPublic ws As WorksheetPublic iv As WorksheetPublic LastRow As LongPublic cell As RangePublic FindvaluePublic NoteHistory As StringPublic Due As StringPublic Address As StringPublic Customer As StringPublic OrderID As StringPublic SearchAll As BooleanPublic OverDue As BooleanPublic File As StringPublic File2 As String
Private Sub MultiPage1_Change()If MultiPage1.Value = 0 Then Me.AcroPDF1.src = FileElseIf MultiPage1.Value = 1 Then Me.AcroPDF2.src = File2End IfEnd Sub
Private Sub UserForm_Initialize()Call OrderAlertCall EmailEnd Sub
Sub Email() Set ws = Worksheets("Order Status") Dim OutApp As Object Dim OutMail As Object Dim DC As Integer Dim Recip As String ws.Unprotect X = "G" LastRow = ws.Range(X & "1").SpecialCells(xlCellTypeLastCell).Row
For DC = 2 To LastRow If (((ws.Cells(DC, X).Value) + 365) <= Now()) And (ws.Cells(DC, X).Value <> "") And (ws.Cells(DC, X).Offset(0, -2).Font.Strikethrough = False) And (ws.Cells(DC, X).Offset(0, 8).Value <> "Yes") Then If ws.Cells(DC, X).Offset(0, -6).Value = "MRRR" Then ws.Cells(DC, X).Value = "Ralph Richardson" ElseIf ws.Cells(DC, X).Offset(0, -6).Value = "John Harrison" Then Recip = "j.harrison" ElseIf ws.Cells(DC, X).Offset(0, -6).Value = "Benjamin Lyon" Then Recip = "b.lyon" ElseIf ws.Cells(DC, X).Offset(0, -6).Value = "Mike Hempstead" Then Recip = "m.hempstead" ElseIf ws.Cells(DC, X).Offset(0, -6).Value = "Jason Lovett" Then Recip = "j.lovett" ElseIf ws.Cells(DC, X).Offset(0, -6).Value = "Dean Wilson" Then Recip = "d.wilson" ElseIf ws.Cells(DC, X).Offset(0, -6).Value = "Paul O'Neill" Then Recip = "p.oneill" ElseIf ws.Cells(DC, X).Offset(0, -6).Value = "Simeon Ong" Then Recip = "s.ong" End If
With Application .ScreenUpdating = False .EnableEvents = False End With Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0)
With OutMail .To = Recip & "@meca.com.au" .CC = "" .BCC = "b.lyon@meca.com.au" .Subject = "Reminder for Job Order " & ws.Cells(DC, "G").Offset(0, -5).Value .Body = "Hello," & Chr(10) & _ "This is a reminder, it has been 1 year since the completion of Job Order " & ws.Cells(DC, "G").Offset(0, -5).Value & "," & Chr(10) & _ "Please contact " & ws.Cells(DC, "G").Offset(0, -4).Value & " to organise a site inspection for maintenance repairs and/or an inspection," & Chr(10) & _ Chr(10) & "Kind Regards," & Chr(10) & Chr(10) & "Benjamin Lyon." 'You can add other files also like this .Attachments.Add ("file:///\\mecaserver\meca\BEN LYON\WAREHOUSE\PICK SLIPS\" & ws.Cells(DC, "G").Offset(0, -5).Value) .Display 'or use .Display End With
ws.Cells(DC, X).Offset(0, 8).Value = "Yes"
Set OutMail = Nothing Set OutApp = Nothing
With Application .ScreenUpdating = True .EnableEvents = True End With End If Next DC ws.ProtectEnd Sub
Private Sub UpdateOrder_Exit(ByVal Cancel As MSForms.ReturnBoolean)Call OrderAlertEnd Sub
Private Sub NewOrder_Exit(ByVal Cancel As MSForms.ReturnBoolean)Call OrderAlertEnd Sub
Public Sub OrderAlert()Set ws = Worksheets("Order Status")Dim Q As IntegerDim y As Integerws.UnprotectMe.Alerts.Caption = ""Me.Alerts2.Caption = "" X = "F" LastRow = ws.Range(X & "1").SpecialCells(xlCellTypeLastCell).Row
For Q = 2 To LastRow If (ws.Cells(Q, "F").Value < Date) And (ws.Cells(Q, "F").Offset(0, 1).Value = "") And (ws.Cells(Q, "C").Font.Strikethrough <> False) Then Me.Alerts.Caption = Me.Alerts.Caption & Chr(10) & ws.Cells(Q, "F").Offset(0, -4).Value & " " & ws.Cells(Q, "F").Value & " OVERDUE!" End If Next Q For y = 2 To LastRow If (ws.Cells(y, "F").Value <= (Date + 14)) And (ws.Cells(y, "F").Value >= Date) And (ws.Cells(y, "F").Offset(0, 1).Value = "") And (ws.Cells(y, "C").Font.Strikethrough = False) Then Me.Alerts2.Caption = Me.Alerts2.Caption & Chr(10) & ws.Cells(y, "F").Offset(0, -4).Value & " " & ws.Cells(y, "F").Value & " Due Soon" End If Next y ws.ProtectEnd Sub
Private Sub Choice_Change()Set ws = Worksheets("Order Status")
If Me.Choice.Value = "Not Dispatched" Then Me.TextBox1.Value = "" Me.TextBox1.Enabled = False Txt = "" X = "K"ElseIf Me.Choice.Value = "Not Completed" Then Me.TextBox1.Value = "" Me.TextBox1.Enabled = False Txt = "" X = "G"ElseIf Me.Choice.Value = "Job Code" Then Me.TextBox1.Enabled = True X = "B"ElseIf Me.Choice.Value = "Customer" Then Me.TextBox1.Enabled = True X = "C"ElseIf Me.Choice.Value = "Freight Code" Then Me.TextBox1.Enabled = True X = "J"ElseIf Me.Choice.Value = "All" Then Me.TextBox1.Value = "MR" Me.TextBox1.Enabled = False X = "B"ElseIf Me.Choice.Value = "OVERDUE" Then OverDue = True Me.TextBox1.Enabled = False X = "F"ElseIf Me.Choice.Value = "Due Soon" Then OverDue = False Me.TextBox1.Enabled = False X = "F"
End If
End Sub
Private Sub cmdLookup_Click()Set ws = Worksheets("Order Status")Dim sAddr As StringDim Z As Integer
ListBox1.ClearZ = 2
Txt = Me.TextBox1.Value
ListBox1.Clearws.Unprotect
LastRow = ws.Range(X & "1").SpecialCells(xlCellTypeLastCell).Row
If X = "K" Then For Z = 2 To LastRow If (ws.Cells(Z, X).Value = Txt) And IsEmpty(ws.Cells(Z, X).Offset(0, -4).Value) = False Then With Me.ListBox1 .AddItem .List(.ListCount - 1, 0) = ws.Cells(Z, X).Offset(0, -10).Value .List(.ListCount - 1, 1) = ws.Cells(Z, X).Offset(0, -9).Value .List(.ListCount - 1, 2) = ws.Cells(Z, X).Offset(0, -8).Value .List(.ListCount - 1, 3) = ws.Cells(Z, X).Offset(0, -6).Value .List(.ListCount - 1, 4) = Format(ws.Cells(Z, X).Offset(0, -5).Value, "dd/mmm/yyyy") End With End If Next Z ElseIf X = "G" Then For Z = 2 To LastRow If (ws.Cells(Z, X).Value = Txt) And (ws.Cells(Z, X).Offset(0, -2).Font.Strikethrough = False) Then With Me.ListBox1 .AddItem .List(.ListCount - 1, 0) = ws.Cells(Z, X).Offset(0, -6).Value .List(.ListCount - 1, 1) = ws.Cells(Z, X).Offset(0, -5).Value .List(.ListCount - 1, 2) = ws.Cells(Z, X).Offset(0, -4).Value .List(.ListCount - 1, 3) = ws.Cells(Z, X).Offset(0, -2).Value .List(.ListCount - 1, 4) = Format(ws.Cells(Z, X).Offset(0, -1).Value, "dd/mmm/yyyy") End With End If Next Z ElseIf X = "B" Then For Z = 2 To LastRow If (ws.Cells(Z, X).Offset(0, 2).Font.Strikethrough = False) And (Not ws.Cells(Z, X).Find(Txt) Is Nothing) Then With Me.ListBox1 .AddItem .List(.ListCount - 1, 0) = ws.Cells(Z, X).Offset(0, -1).Value .List(.ListCount - 1, 1) = ws.Cells(Z, X).Value .List(.ListCount - 1, 2) = ws.Cells(Z, X).Offset(0, 1).Value .List(.ListCount - 1, 3) = ws.Cells(Z, X).Offset(0, 3).Value .List(.ListCount - 1, 4) = Format(ws.Cells(Z, X).Offset(0, 4).Value, "dd/mmm/yyyy") End With ElseIf (ws.Cells(Z, X).Offset(0, 2).Font.Strikethrough = True) And (Not ws.Cells(Z, X).Find(Txt) Is Nothing) Then MsgBox ("Order " & ws.Cells(Z, X).Value & " has been Cancelled, Reason: " & ws.Cells(Z, X).Offset(0, 10).Value), vbExclamation If Me.TextBox1.Enabled Then Me.TextBox1.SetFocus End If Exit Sub End If Next Z ElseIf X = "C" Then
For Z = 2 To LastRow If (ws.Cells(Z, X).Font.Strikethrough = False) And (Not ws.Cells(Z, X).Find(Txt) Is Nothing) Then With Me.ListBox1 .AddItem .List(.ListCount - 1, 0) = ws.Cells(Z, X).Offset(0, -2).Value .List(.ListCount - 1, 1) = ws.Cells(Z, X).Offset(0, -1).Value .List(.ListCount - 1, 2) = ws.Cells(Z, X).Value .List(.ListCount - 1, 3) = ws.Cells(Z, X).Offset(0, 2).Value .List(.ListCount - 1, 4) = Format(ws.Cells(Z, X).Offset(0, 3).Value, "dd/mmm/yyyy") End With End If Next Z
ElseIf X = "J" Then
For Z = 2 To LastRow If (ws.Cells(Z, X).Font.Strikethrough = False) And (Not ws.Cells(Z, X).Find(Txt) Is Nothing) Then With Me.ListBox1 .AddItem .List(.ListCount - 1, 0) = ws.Cells(Z, X).Offset(0, -9).Value .List(.ListCount - 1, 1) = ws.Cells(Z, X).Offset(0, -8).Value .List(.ListCount - 1, 2) = ws.Cells(Z, X).Offset(0, -7).Value .List(.ListCount - 1, 3) = ws.Cells(Z, X).Offset(0, -5).Value .List(.ListCount - 1, 4) = Format(ws.Cells(Z, X).Offset(0, -4).Value, "dd/mmm/yyyy") End With End If Next Z ElseIf X = "F" Then For Z = 2 To LastRow If OverDue Then If (ws.Cells(Z, X).Value < Date) And (ws.Cells(Z, X).Offset(0, 1).Value = "") And (ws.Cells(Z, X).Offset(0, -3).Font.Strikethrough = False) Then With Me.ListBox1 .AddItem .List(.ListCount - 1, 0) = ws.Cells(Z, X).Offset(0, -5).Value .List(.ListCount - 1, 1) = ws.Cells(Z, X).Offset(0, -4).Value .List(.ListCount - 1, 2) = ws.Cells(Z, X).Offset(0, -3).Value .List(.ListCount - 1, 3) = ws.Cells(Z, X).Offset(0, -1).Value .List(.ListCount - 1, 4) = Format(ws.Cells(Z, X).Value, "dd/mmm/yyyy") End With End If ElseIf (OverDue = False) Then If (ws.Cells(Z, X).Value < (Date + 14)) And (ws.Cells(Z, X).Value >= Date) And (ws.Cells(Z, X).Offset(0, 1).Value = "") And (ws.Cells(Z, X).Offset(0, -3).Font.Strikethrough = False) Then With Me.ListBox1 .AddItem .List(.ListCount - 1, 0) = ws.Cells(Z, X).Offset(0, -5).Value .List(.ListCount - 1, 1) = ws.Cells(Z, X).Offset(0, -4).Value .List(.ListCount - 1, 2) = ws.Cells(Z, X).Offset(0, -3).Value .List(.ListCount - 1, 3) = ws.Cells(Z, X).Offset(0, -1).Value .List(.ListCount - 1, 4) = Format(ws.Cells(Z, X).Value, "dd/mmm/yyyy") End With End If End If Next ZEnd Ifws.Protect
End Sub
Private Sub ListBox1_Click()Dim ws As WorksheetSet ws = Worksheets("Order Status")Dim i As IntegerDim OrderFind
ws.Unprotect For i = 0 To Me.ListBox1.ListCount If Me.ListBox1.Selected(i) Then OrderID = Me.ListBox1.List(i, 1) End If Next i Set OrderFind = ws.Range("B:B").Find(OrderID).Offset(0, -1) Due = OrderFind.Offset(0, 5) Address = OrderFind.Offset(0, 4) Customer = OrderFind.Offset(0, 3)ws.Protect
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim JobCode As String Dim i As Integer Dim ws As Worksheet Set ws = Worksheets("Order Status") Dim y As Integer Dim cNum As Integer
ws.Unprotect For i = 0 To Me.ListBox1.ListCount If Me.ListBox1.Selected(i) = True Then JobCode = Me.ListBox1.List(i, 1) End If Next i Set Findvalue = ws.Range("B:B").Find(JobCode).Offset(0, -1) Me.T1.Caption = Findvalue Me.T2.Caption = Findvalue.Offset(0, 1) Me.T3.Caption = Findvalue.Offset(0, 2) Me.T4.Caption = Findvalue.Offset(0, 4) Me.T5.Caption = Findvalue.Offset(0, 5) Me.T6.Caption = Findvalue.Offset(0, 6) Me.T7.Caption = Findvalue.Offset(0, 7) Me.T8.Caption = Findvalue.Offset(0, 8) Me.T9.Caption = Findvalue.Offset(0, 9) Me.T10.Caption = Findvalue.Offset(0, 10) Me.T11.Caption = Findvalue.Offset(0, 12) Me.T12.Caption = "Notes for Job Order " & JobCode Me.T13.Caption = Findvalue.Offset(0, 13) File = "file:///\\mecaserver\meca\BEN LYON\WAREHOUSE\PICK SLIPS\" & Findvalue.Offset(0, 1) & ".pdf" Me.AcroPDF1.src = File File2 = "file:///\\mecaserver\meca\BEN LYON\WAREHOUSE\AddOnFile\" & Findvalue.Offset(0, 1) & ".pdf"ws.ProtectEnd Sub
Private Sub NewOrder_Click()OrderEntryForm.ReceivedDate.Value = Format(Now(), "dd/mm/yyyy")OrderEntryForm.ShowEnd Sub
Private Sub UpdateOrder_Click()OrderUpdate.ComboBox2.Text = Me.OrderIDOrderUpdate.Due.Value = Me.DueOrderUpdate.OrderAddress.Value = Me.AddressOrderUpdate.Customer.Value = Me.CustomerOrderUpdate.ShowEnd Sub
Private Sub CommandButton1_Click() With PickSlip .P1.Caption = Me.T2 .P2.Caption = Me.T3 .P3.Caption = Me.T4 .P4.Caption = Me.T5 .Show End With
End Sub
Private Sub NoteAdd_Click()Dim ws As WorksheetSet ws = Worksheets("Order Status")
ws.Unprotect
If Me.NotesBox.Value = "" Or Me.NotesBox.Value = Me.T13.Caption Then MsgBox "There are no NEW NOTES to add to the order!", vbExclamation Exit SubElseFindvalue.Offset(0, 13) = Me.T13.Caption & Chr(10) & "*" & Format(Now(), "dd/mmm/yy h:nn AM/PM") & "* " & Me.NotesBox.ValueEnd If
ws.Protect , AllowFiltering:=True
Me.NotesBox.Value = ""Me.T13.Caption = Findvalue.Offset(0, 13)
End Sub
