Sub colod()
''reminders
X = MsgBox("Have you updated the added and removed boxes from this week's PostBox update file? ", vbQuestion + vbYesNo, Title:="A quick reminder before we begin :)")
If X = vbNo Then
MsgBox "This needs to be done before we can proceed any further , please do this and return once this has been done ....EXITING"
Exit Sub
Else
MsgBox "Excellent, press OK to continue", vbOKOnly
End If
'Opening the latest colod report
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\CODOL ISSUE June 2015"
cDrive = Left((ThisWorkbook.Path), 1)
ChDrive Left((ThisWorkbook.Path), 1)
ChDir (cDrive & sDirDefault)
colodFile = Application.GetOpenFilename(Title:="Please open the latest Colod Switched Over Report")
If colodFile = False Then Exit Sub
'colod file name
cfile = Mid(colodFile, InStrRev(colodFile, "\") + 1, (InStrRev(colodFile, "x") - InStrRev(colodFile, "\")))
Workbooks.Open (cfile)
' cmd reminder
mresults = MsgBox("Have you asked for todays CMD file from DBA ????", vbYesNo, "We need the CMD file")
If mresults = vbYes Then
r = MsgBox("Thta's a great start , have you conactenated the postbox in first column too ?", vbYesNo, Title:="Additional Tasks")
If r = vbYes Then
MsgBox ("Excellent , we may proceed with this weeks report")
MsgBox ("Unfortunaley we will not be able to continue with that format , please concatenates the PostBoxes and Restart this macro,Exiting")
MsgBox ("Unfortunaley we will not be able to continue without the CMD file, Please EMail DBA and ask for the CMD file,Exiting")
''Part 1 CMD parts
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\CODOL ISSUE June 2015\CMD Files"
DirCMD = Application.GetOpenFilename(Title:="Please Open the latest CMD file")
If DirCMD = False Then Exit Sub
cmd = Mid(DirCMD, InStrRev(DirCMD, "\") + 1, (InStrRev(DirCMD, "v") - InStrRev(DirCMD, "\")))
Workbooks.Open (DirCMD)
Workbooks(cfile).Activate
Sheets("COD PostBox status").Activate
'Declaring some variables
stc = Range("a2", Range("a2").End(xlToRight)).Find(what:="Current Postbox Status", MatchCase:=True).Column
''Part 2 adding this weeks scheduled time of posting from CMD
Columns(stc).Insert
Cells(1, stc).Value = Cells(1, stc - 1) + 7
Cells(2, stc).Value = "Scheduled Collection"
Range(Cells(3, stc), Cells(3, stc)).Formula = "=VLOOKUP(B3,'" & cmd & "'!$A:$F,6,FALSE)"
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(3, stc), Cells(3, stc)).AutoFill Destination:=Range(Cells(3, stc), Cells(lr, stc))
Range(Cells(3, stc), Cells(lr, stc)).Copy
Range(Cells(3, stc), Cells(3, stc)).PasteSpecial xlPasteValues
''part 3 updating time of collection for status 2 boxes to 9:00 am
sColumn = Range("a2", Range("a2").End(xlToRight)).Find(what:="Current Postbox Status", MatchCase:=True).Column
Range("w2").AutoFilter Field:=sColumn, Criteria1:=2
Range("v2").AutoFilter Field:=sColumn - 1, Criteria1:=900
TFirstRow = Range("a3:a" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Row
TlastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(TFirstRow, sColumn), Cells(TlastRow, sColumn)).SpecialCells(xlCellTypeVisible).Value = 3
' correct the ranges to cells with variable vlaues from below
prt = Range("a2", Range("a2").End(xlToRight)).Find(what:="Date switched to Post revision - Status 3", MatchCase:=True).Column
Range(Cells(3, prt), Cells(lr, prt)).SpecialCells(xlCellTypeVisible).Value = Cells(1, stc).Value
ActiveSheet.ShowAllData
''part 4 updating resinated but 9:00 am tab
Range("w2").AutoFilter Field:=sColumn, Criteria1:=1
Sheets("Reinstated but 9am").Activate
Sheets("Reinstated but 9am").Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row).Value = ""
Sheets("COD Postbox status").Activate
Range("b3:b" & lr).SpecialCells(xlCellTypeVisible).Copy
Sheets("Reinstated but 9am").Range("a2").PasteSpecial xlPasteValues
dateone = Range("a2", Range("a2").End(xlToRight)).Find(what:="Date reinstated to Status 1", lookat:=xlWhole, MatchCase:=True).Column
Range("b2:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value = "900"
Range("c2").Formula = "=VLOOKUP(A2,'COD Postbox status'!$B:$ZZ," & dateone - 1 & ",FALSE)"
Range("c2").AutoFill Destination:=Range("c2:c" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("c2:c" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
Range("c2").PasteSpecial xlPasteValues
Range("c2:c" & Cells(Rows.Count, 1).End(xlUp).Row).NumberFormat = "dd/mm/yyyy"
''Part 5 reinstated but not on the list tab
Sheets("Reinstated but not on list").Activate
Range("a2:D" & Cells(Rows.Count, 1).End(xlUp).Row).Value = ""
Range("w2").AutoFilter Field:=sColumn, Criteria1:=3
Range("v2").AutoFilter Field:=sColumn - 1, Criteria1:="<>900"
Range("b3:b" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
Sheets("Reinstated but not on list").Range("a2").PasteSpecial xlPasteValues
newx = Range("e1").End(xlToRight).Column
X = newx - 1
dtr = Range("a2", Range("a2").End(xlToRight)).Find("Date switched to Post revision - Status 3").Column
Range("b2").Formula = "=VLOOKUP(A2,'COD Postbox status'!$B:$ZZ," & X & ",FALSE)"
Range("b2").AutoFill Destination:=Range("b2:b" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("b2:b" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
Range("b2").PasteSpecial xlPasteValues
Range("b2:b" & Cells(Rows.Count, 1).End(xlUp).Row).Replace "#N/A", "-"
Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row).Value = "3"
Range("d2").Formula = "=VLOOKUP(A2,'COD Postbox status'!$B:$ZZ," & dtr - 1 & ",FALSE)"
Range("d2").AutoFill Destination:=Range("D2:D" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("D2:D" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
Range("d2").PasteSpecial xlPasteValues
''Part6 updating Final Plate vs cmd file tab
''''''''''''''''''''''''''''''''''''''''''updating the CMD Part first
Sheets("CMD vs Final Plate").Activate
ActiveSheet.AutoFilterMode = False
lr = Range("a3").End(xlDown).Row
Range("d4:d" & lr).Value = ""
Range("d4").Formula = "=VLOOKUP(A4,'" & cmd & "'!$A:$A,1,FALSE)"
Range("d4").AutoFill Destination:=Range("d4:D" & lr)
Range("d4:D" & lr).Copy
Range("d4").PasteSpecial xlPasteValues
Range("d3").AutoFilter Field:=4, Criteria1:="<>#N/A"
Range("d4:D" & lr).SpecialCells(xlCellTypeVisible).Value = "Y"
Range("d3").AutoFilter Field:=4, Criteria1:="#N/A"
Range("d4:D" & lr).SpecialCells(xlCellTypeVisible).Value = "N"
lr = Range("h4").End(xlDown).Row
Range("J4:J" & lr).Value = ""
Range("J4").Formula = "=VLOOKUP(H4,'" & cmd & "'!$A:$A,1,FALSE)"
Range("J4").AutoFill Destination:=Range("J4:J" & lr)
Range("J4:J" & lr).Copy
Range("J4").PasteSpecial xlPasteValues
Range("j3").AutoFilter Field:=3, Criteria1:="<>#N/A"
Range("j4:j" & lr).SpecialCells(xlCellTypeVisible).Value = "Y"
Range("J3").AutoFilter Field:=3, Criteria1:="#N/A"
Range("J4:J" & lr).SpecialCells(xlCellTypeVisible).Value = "N"
Workbooks(cmd).Activate
Range("a1").AutoFilter Field:=1, Criteria1:="<> "
CMDnumbers = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Count
Sheets("summary").Activate
Range("v15").Value = CMDnumbers - 1
Workbooks(cmd).Close savechanges:=False
'' opening the latest final Plate file
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\Postbox Database Current"
finalplateDrive = Application.GetOpenFilename(Title:="Please select the latest Final Plate file")
FinalPlate = Mid(finalplateDrive, InStrRev(finalplateDrive, "\") + 1, (InStrRev(finalplateDrive, "x") - InStrRev(finalplateDrive, "\")))
Workbooks.Open (finalplateDrive)
Workbooks(cfile).Sheets("CMD vs Final Plate").Activate
''updating the Final Plate look ups
lr = Range("C3").End(xlDown).Row
Range("c4:c" & lr).Value = ""
Range("c4").Formula = "=IFERROR(VLOOKUP(A4,'[" & FinalPlate & "]Sheet1'!$A:$A,1,FALSE),VLOOKUP(B4,'[" & FinalPlate & "]Sheet1'!$A:$A,1,FALSE))"
Range("c4").AutoFill Destination:=Range("c4:c" & lr)
Range("c4:c" & lr).Copy
Range("c4").PasteSpecial xlPasteValues
Range("c3").AutoFilter Field:=3, Criteria1:="<>#N/A"
Range("C4:C" & lr).SpecialCells(xlCellTypeVisible).Value = "Y"
Range("c3").AutoFilter Field:=3, Criteria1:="#N/A"
Range("C4:C" & lr).SpecialCells(xlCellTypeVisible).Value = "N"
''finalPlate Table updates
lr = Range("K4").End(xlDown).Row
Range("K4:K" & lr).Value = ""
Range("K4").Formula = "=IFERROR(VLOOKUP(H4,'[" & FinalPlate & "]Sheet1'!$A:$A,1,FALSE),VLOOKUP(I4,'[" & FinalPlate & "]Sheet1'!$A:$A,1,FALSE))"
Range("K4").AutoFill Destination:=Range("K4:K" & lr)
Range("K4:K" & lr).Copy
Range("K4").PasteSpecial xlPasteValues
Range("K3").AutoFilter Field:=4, Criteria1:="<>#N/A"
Range("K4:K" & lr).SpecialCells(xlCellTypeVisible).Value = "Y"
Range("K3").AutoFilter Field:=4, Criteria1:="#N/A"
Range("K4:K" & lr).SpecialCells(xlCellTypeVisible).Value = "N"
Workbooks(FinalPlate).Activate
FinalPlateRow = Range("a2").End(xlDown).Row
Sheets("Summary").Activate
Range("s15").Value = FinalPlateRow - 1
Workbooks(FinalPlate).Close savechanges:=False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\CODOL ISSUE June 2015\Pans Updated LATs\YTD LAT calls"
blackDrive = Application.GetOpenFilename(Title:="Please select The Black List Master file")
blacklist = Mid(blackDrive, InStrRev(blackDrive, "\") + 1, (InStrRev(blackDrive, "x") - InStrRev(blackDrive, "\")))
Workbooks.Open (blackDrive)
''Look ups for the cmd Part
Range("e4").Formula = "=IFERROR(VLOOKUP(A4,'[" & blacklist & "]RM Suspension'!$A:$D,4,FALSE),"" - "")"
Range("e4").AutoFill Destination:=Range("e4:e" & lr)
Range("e4:E" & lr).Copy
Range("e4").PasteSpecial xlPasteValues
''look ups for the final Plate parts
lr = Range("h3").End(xlDown).Row
Range("l4").Formula = "=IFERROR(VLOOKUP(H4,'[" & blacklist & "]RM Suspension'!$A:$D,4,FALSE),"" - "")"
Range("l4").AutoFill Destination:=Range("l4:l" & lr)
Range("l4:l" & lr).Copy
Range("l4").PasteSpecial xlPasteValues
Workbooks(blacklist).Close savechanges:=False
Application.CutCopyMode = False
'''''''''''Updating Panellist LAt TAB
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\CODOL ISSUE June 2015\Pans Updated LATs"
panDrive = Application.GetOpenFilename(Title:="Please select the latest Number of Panellist file")
panup = Mid(panDrive, InStrRev(panDrive, "\") + 1, (InStrRev(panDrive, "x") - InStrRev(panDrive, "\")))
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\CODOL ISSUE June 2015\Pans Updated LATs\Call Lists"
callListDrive = Application.GetOpenFilename(Title:="Please open the latest call list")
callList = Mid(callListDrive, InStrRev(callListDrive, "\") + 1, (InStrRev(callListDrive, "x") - InStrRev(callListDrive, "\")))
Workbooks.Open (callListDrive)
Workbooks.Open (panDrive)
Workbooks(callList).Activate
clsheet = Application.InputBox("Please Type in the latest date of call lists")
Sheets(clsheet).Activate
On Error Resume Next
On Error GoTo 0
lr = Range("a1").End(xlDown).Row
Range("C2:C" & lr).Copy
Workbooks(panup).Sheets("Data").Range("a1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Range("d2:D" & lr).Copy
Workbooks(panup).Sheets("Data").Range("b1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Range("F2:F" & lr).Copy
Workbooks(panup).Sheets("Data").Range("c1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Range("G2:H" & lr).Copy
Workbooks(panup).Sheets("Data").Range("G1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Workbooks(panup).Sheets("Data").Activate
lr = Range("a2").End(xlDown).Row
fr = Range("e2").End(xlDown).Offset(1, 0).Row
Workbooks(cfile).Sheets("COD Postbox status").Activate
sCheck = Range("A2", Range("A2").End(xlToRight)).Find(what:="Current Postbox Status", MatchCase:=True).Column
Range("e" & fr & ":e" & lr).Value = Date
''' this area will need rechecking befor next run
Range("f" & fr).Formula = "=IFERROR(VLOOKUP([@LocationDescription],'[" & cfile & "]COD Postbox status'!$B:$XFD," & sCheck - 1 & ",FALSE),1)"
Range("f" & fr).AutoFill Destination:=Range("f" & fr & ":f" & lr)
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
''part xx updating the RM to confirm Switched Tab
sCheck = Range("a2", Range("a2").End(xlToRight)).Find(what:="Current Postbox Status", MatchCase:=True).Column
Columns(sCheck).Insert
newcol = Range("a2").End(xlToRight).Column
newcol2 = newcol + 1
Range(Cells(3, newcol), Cells(lr, newcol)).Copy
Cells(3, newcol2).PasteSpecial xlPasteValues
Range("a2").AutoFilter Field:=newcol, Criteria1:="<1200"
Range("a2").AutoFilter Field:=newcol2, Criteria1:="<>0", Criteria2:="<>900"
MsgBox "data is filtered to show data for RM to confirmed Switch Tab", vbInformation, "Just to let you know"
MsgBox "Please Remember to Delete the spare Column created before current PostBox Status", vbCritical, Title:="REMINDER"
End Sub