'Routine to track reject data
'Written by Operator 7014
'V 1.0.0 Initial version
'V 1.0.1 Clean up of processes
'V 1.1.0 Added save routine, edited method of date input, added WMTWeek, WMT Year
' And DC Number. Deleted form for date.
'V 1.1.1 Removed button form that showed at startup (for compatibility with other reports
Code
Sub RejectReport()
Dim DCNumber As String
DCNumber = Worksheets("Summary").Range("F2").Value
'Copy Return Code Column
Application.DisplayAlerts = False
ActiveSheet.Cells(1, 1).Select
ActiveSheet.Cells.ClearContents
Workbooks.Open "\\US0" & DCNumber & "NT800fil\Public\Automation\rejects.csv"
ActiveSheet.Range("f9:f65536").Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
ActiveSheet.PasteSpecial
'Copy Timestamp and TU ID Columsn
Workbooks.Open "\\US0" & DCNumber & "NT800fil\Public\Automation\rejects.csv"
ActiveSheet.Range("h9:i65536").Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
ActiveSheet.Cells(1, 2).Select
ActiveSheet.PasteSpecial
'Copy Source Column
Workbooks.Open "\\US0" & DCNumber & "NT800fil\Public\Automation\rejects.csv"
Columns(11).NumberFormat = "##-###-####-###"
ActiveSheet.Range("k9:k65536").Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
ActiveSheet.Cells(1, 4).Select
ActiveSheet.PasteSpecial
'Format Table
Rows(1).Font.Bold = True
Rows(1).Font.Bold = True
Rows(1).HorizontalAlignment = xlCenter
Columns(1).HorizontalAlignment = xlCenter
Columns(1).ColumnWidth = 11.29
Columns(2).ColumnWidth = 18.43
Columns(3).ColumnWidth = 8.57
Columns(4).ColumnWidth = 14.71
Columns(5).ColumnWidth = 8.57
Cells(1, 5).Value = "FZ or DD"
Columns(5).HorizontalAlignment = xlCenter
'Insert Formula to mark as FZ or DD
Cells(2, 5).Value = "=IF(LEFT(D2,5)=""10-01"",""FZ"",""DD"")"
'Copy Formula down
Dim LastRow As Long
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("E2:E" & LastRow).FillDown
'Insert FZ Induct Data
Workbooks.Open "\\US0" & DCNumber & "NT800fil\Public\Automation\InductsFZ.csv"
ActiveSheet.Range("B9:b65536").Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
ActiveSheet.Cells(2, 7).Select 'TU ID
ActiveSheet.PasteSpecial
Workbooks.Open "\\US0" & DCNumber & "NT800fil\Public\Automation\InductsFZ.csv"
ActiveSheet.Range("i9:i65536").Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
ActiveSheet.Cells(2, 8).Select 'Time Stamp
ActiveSheet.PasteSpecial
ActiveSheet.Range("G1:H1").Select
Selection.Merge
ActiveSheet.Cells(1, 7).Value = "Freezer Inducts"
'Insert DD Induct Data
Workbooks.Open "\\US0" & DCNumber & "NT800fil\Public\Automation\InductsDD.csv"
ActiveSheet.Range("B9:b65536").Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
ActiveSheet.Cells(2, 10).Select 'TU ID
ActiveSheet.PasteSpecial
Workbooks.Open "\\US0" & DCNumber & "NT800fil\Public\Automation\InductsDD.csv"
ActiveSheet.Range("i9:i65536").Select
Selection.Copy
ActiveWorkbook.Close SaveChanges:=False
ActiveSheet.Cells(2, 11).Select 'Time Stamp
ActiveSheet.PasteSpecial
ActiveSheet.Range("J1:K1").Select
Selection.Merge
ActiveSheet.Cells(1, 10).Value = "Dairy Deli Inducts"
'Format Induct Columns
ActiveSheet.Range("G2:K2").Select
Selection.HorizontalAlignment = xlCenter
Selection.Font.Bold = True
Columns(7).ColumnWidth = 9.29
Columns(8).ColumnWidth = 18.43
Columns(10).ColumnWidth = 9.29
Columns(11).ColumnWidth = 18.43
Application.Calculate 'Recalculate formulas
End Sub
Display More