Hey all,
Thought I'd give you folks a good laugh, perhaps even a hard cry by taking a look at the "Submit" button i have in my ever growing user form for an Order Follow up system. This is a multitude of other's work stitched and sewn together over the years. Everything is working, and it's not even slow, but i know there is a better way to do this. I'd like a good critiquing(roast) if you will. Thanks in advance, and don't be shy.
Thought I'd give you folks a good laugh, perhaps even a hard cry by taking a look at the "Submit" button i have in my ever growing user form for an Order Follow up system. This is a multitude of other's work stitched and sewn together over the years. Everything is working, and it's not even slow, but i know there is a better way to do this. I'd like a good critiquing(roast) if you will. Thanks in advance, and don't be shy.
Code:
Private Sub cmbSubmit_Click()
Dim rowCount As Long
Dim ctl As Control
Dim iRow As Long
Dim WS As Worksheet
Set WS = Worksheets("Order Status")
strPwd = "2885"
With ActiveSheet
.Unprotect Password:=strPwd
On Error Resume Next
.ShowAllData
.Protect _
Contents:=True, _
AllowFiltering:=True, _
userinterfaceonly:=True, _
Password:=strPwd
End With
''' Check user input
If txtvendor.Value = "" Then
MsgBox "You must enter the Vendor Name!", vbCritical
Me.txtvendor.SetFocus
Exit Sub
End If
If txtcust.Value = "" Then
MsgBox "You must enter the Customer Name!", vbCritical
Me.txtcust.SetFocus
Exit Sub
End If
If txtSSPO.Value = "" Then
MsgBox "You must enter the Smart Source PO number!", vbCritical
Me.txtSSPO.SetFocus
Exit Sub
End If
If txtREQSD.Value = "" Then
MsgBox "You must enter a requested Ship Date!", vbCritical
Me.txtREQSD.SetFocus
Exit Sub
End If
Dim Msg As String, Ans As Variant
If txtihd.Value = "" Then
Msg = "Is there an in hands date for this order??"
Ans = MsgBox(Msg, vbYesNo)
Select Case Ans
Case vbYes
Me.txtihd.SetFocus
Exit Sub
Case vbNo
GoTo Quit:
End Select
Quit:
End If
If drpUserSingle.Value = "" Then
MsgBox "You must select a User!", vbCritical
Me.drpUserSingle.SetFocus
Exit Sub
End If
txtNotes.Value = txtNotes.Value & vbNewLine & Now & ":" & " Submitted PO"
cbStat.Value = "Submitted"
'find first empty row in database
iRow = WS.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
Sheets("Order Status").Unprotect Password:="2885"
FilterOff
' Write data to worksheet
rowCount = Worksheets("Order Status").Cells(Worksheets("Order Status").Rows.Count, 1).End(xlUp).Row
With Worksheets("Order Status").Range("A1")
.Offset(rowCount, 0).Value = Date
.Offset(rowCount, 1).Value = Me.txtvendor.Value
.Offset(rowCount, 2).Value = Me.txtcust.Value
.Offset(rowCount, 3).Value = Me.txtSSPO.Value
.Offset(rowCount, 4).Value = Me.txtVOrder.Value
.Offset(rowCount, 5).Value = Me.txtREQSD.Value
.Offset(rowCount, 6).Value = Me.txtihd.Value
.Offset(rowCount, 7).Value = Me.chkREQ.Value
.Offset(rowCount, 8).Value = Me.chkRCVD.Value
.Offset(rowCount, 9).Value = Me.chkAPPR.Value
.Offset(rowCount, 10).Value = Me.txtTrack.Value
.Offset(rowCount, 11).Value = Me.txtASD.Value
.Offset(rowCount, 12).Value = Me.cbStat.Value
.Offset(rowCount, 13).Value = Me.txtVendEML.Value
.Offset(rowCount, 14).Value = Me.drpUserSingle.Value
.Offset(rowCount, 15).Value = Me.txtNotes.Value
.Offset(rowCount, 16).Value = Me.txtLogo.Value
.Offset(rowCount, 17).Value = Me.txtrep.Value
.Offset(rowCount, 18).Value = Me.txtESD.Value
End With
Dim nwb As Workbook
Set nwb = Workbooks.Open("C:\Users\DReardon\Desktop\Hub Folder\HUB.xlsm")
'Determine emptyRow
Dim emptyRow As Long
emptyRow = WorksheetFunction.CountA(nwb.Sheets("Status").Range("A:A")) + 1
'Transfer Information
With nwb.Sheets("Status")
'Datebox
.Cells(emptyRow, 1).Value = txtDateSUB.Value
.Cells(emptyRow, 2).Value = txtvendor.Value
.Cells(emptyRow, 3).Value = txtcust.Value
.Cells(emptyRow, 4).Value = txtSSPO.Value
.Cells(emptyRow, 5).Value = txtVOrder.Value
.Cells(emptyRow, 6).Value = txtREQSD.Value
.Cells(emptyRow, 7).Value = txtihd.Value
.Cells(emptyRow, 8).Value = chkREQ.Value
.Cells(emptyRow, 9).Value = chkRCVD.Value
.Cells(emptyRow, 10).Value = chkAPPR.Value
.Cells(emptyRow, 11).Value = txtTrack.Value
.Cells(emptyRow, 12).Value = txtASD.Value
.Cells(emptyRow, 13).Value = cbStat.Value
.Cells(emptyRow, 14).Value = txtVendEML.Value
.Cells(emptyRow, 15).Value = drpUserSingle.Value
.Cells(emptyRow, 16).Value = txtNotes.Value
.Cells(emptyRow, 17).Value = txtLogo.Value
.Cells(emptyRow, 18).Value = txtrep.Value
.Cells(emptyRow, 19).Value = txtESD.Value
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWindow.Close
Application.DisplayAlerts = True
End With
Sheets("Order Status").Protect Password:="2885"
Application.ScreenUpdating = False
Columns.AutoFit
'VVVVVVVVV TESTING VVVVVVVVVVVV
Application.ScreenUpdating = False
Appointments2
Appointments3
Application.ScreenUpdating = False
ColorCellsWithIncorrectEndDate
Worksheets("Order Status").Columns("P").AutoFit
Worksheets("Order Status").Columns("P").WrapText = False
'HideShipped
'VVVVVVVVV TESTING VVVVVVVVVVVV
If MsgBox("Would you like to submit the PO to the vendor now?", vbYesNo) = vbNo Then Exit Sub
'Create E-mail to Vendor for PO Submit
Dim oOLook As Object
Dim oEMail As Object
Set oOLook = CreateObject("Outlook.Application")
oOLook.Session.Logon
Set oEMail = oOLook.CreateItem(0)
oEMail.Display
On Error Resume Next
With oEMail
.Importance = olImportanceHigh
.To = txtVendEML.Value
.CC = ""
.BCC = ""
.Subject = "Smart Source PO# " & txtSSPO.Value
.Body = "Hi," & vbNewLine & "Attached is Smart Source PO# " & txtSSPO.Value & "." & vbNewLine & _
"Please confirm estimated ship date, and your order # when you have a moment. Thank you and have a great day!" & vbNewLine & "Thanks," & vbNewLine & drpUserSingle.Value
End With
Application.ScreenUpdating = True
End Sub
