Sub FCallList()
'******THIS MACRO IS USING TODAY'S DATE IN SOME OF IT'S FIELDS DURING FILTERATION IN PART 1*****'
'*** YOU NEED TO MAKE SURE ITS RAN ON THE SAME DAY AS MASTER CALL lIST WAS UPDATED'
sDirDefault = ":\Profit Centres\Internal\Mail Centre Products\CODOL ISSUE June 2015\Pans Updated LATs\Call Lists"
cDrive = Left((ThisWorkbook.Path), 1)
ChDrive Left((ThisWorkbook.Path), 1)
ChDir (cDrive & sDirDefault)
CL = Application.GetOpenFilename(Title:=" Please open the latest Master File(call List)")
mCallList = Mid(CL, InStrRev(CL, "\") + 1, InStrRev(CL, "x") - InStrRev(CL, "\"))
Workbooks.Open (CL)
cMonth = Application.InputBox("Please Enter the current Month")
'***PART 1 FILTERING ON THE LATEST DATE
Workbooks(mCallList).Sheets(cMonth & " Calls").Activate
Range("A1").AutoFilter Field:=1, Criteria1:=Format(Date, "DD/MM/YYYY")
Range("A1").AutoFilter Field:=24, Criteria1:="Outstanding"
'***PART 2 Opening the latest Final Plate file
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\Postbox Database Current\" & cMonth & " 2016"
lFinalPlate = Application.GetOpenFilename(Title:="PLEASE SELECT THE MOST RECENT UPDATED FINAL PLATE")
FP = Mid(lFinalPlate, InStrRev(lFinalPlate, "\") + 1, InStrRev(lFinalPlate, "x") - InStrRev(lFinalPlate, "\"))
Workbooks.Open (lFinalPlate)
'***Part 3 Bringing Over the comments from the Final Plate file
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
FirstRow = Range("O2:O" & LastRow).SpecialCells(xlCellTypeVisible).Row
Range("O" & FirstRow).Formula = "=IFERROR(VLOOKUP(F" & FirstRow & ",'[" & FP & "]Sheet1'!$A:$AF,32,FALSE),VLOOKUP(G" & FirstRow & ",'[" & FP & "]Sheet1'!$A:$AF,32,FALSE))"
Range("O" & FirstRow).AutoFill Destination:=Range("O" & FirstRow & ":O" & LastRow)
'***** Part 4 Copy and paste the Final Plate comments and close the Final Plate File
Sheets(cMonth & " Calls").ShowAllData
Range("O" & FirstRow & ":O" & LastRow).Copy
Range("o" & FirstRow).PasteSpecial xlPasteValues
'*****8USING TODAYS DATE IN THE FORMAT, MAY NEED TO UPDATE IT TO A SAFER MODE
Range("a1").AutoFilter Field:=1, Criteria1:=Format(Date, "DD/MM/YYYY")
Range("o1").AutoFilter Field:=15, Criteria1:="#N/A"
Range("O2:O" & LastRow).SpecialCells(xlCellTypeVisible).Value = "PostBox Not in Final Plate"
Range("o1").AutoFilter Field:=15, Criteria1:="No difference"
Range("O2:O" & LastRow).SpecialCells(xlCellTypeVisible).Value = ""
Range("o1").AutoFilter Field:=15, Criteria1:="Changed in the last 3 weeks"
Range("M2:M" & LastRow).SpecialCells(xlCellTypeVisible).Value = "Achieved Call - Panellist Correct"
Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible).Value = "Not Required"
Range("W2:W" & LastRow).SpecialCells(xlCellTypeVisible).Value = "Other"
'****** Part 5 BRINGING OVER THE LATEST FINAL PLATE TIME
Range("AA2:AA" & LastRow).Cells.Clear
Range("z2").Copy
Range("AA2:AA" & LastRow).PasteSpecial xlPasteFormats
'**part 5.1 filtering on MM_FF
Range("a1").AutoFilter Field:=8, Criteria1:="M-F"
fr = Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Row
Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Formula = "=IFERROR(VLOOKUP(F" & fr & ",'[" & FP & "]Sheet1'!$A:$H,8,FALSE),VLOOKUP(G" & fr & ",'[" & FP & "]Sheet1'!$A:$H,8,FALSE))"
Range("a1").AutoFilter Field:=8, Criteria1:="Sat"
Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Formula = "=IFERROR(VLOOKUP(F" & fr & ",'[" & FP & "]Sheet1'!$A:$I,9,FALSE),VLOOKUP(G" & fr & ",'[" & FP & "]Sheet1'!$A:$I,9,FALSE))"
Range("AA2:AA" & LastRow).Copy
Range("AA2").PasteSpecial xlPasteValues
Range("z2").AutoFill Destination:=Range("z2:Z" & LastRow)
Range("a1").AutoFilter Field:=27, Criteria1:="#N/A"
Range("AA2:AA" & LastRow).SpecialCells(xlCellTypeVisible).Value = ""
Workbooks(FP).Close savechanges:=False
'******PART 6 Q&C Sampling data*******
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
Range("AB2:AB" & Lrow).Value = ""
'*** M-F for Q&C Sampling
Range("AB" & fr & ":AB" & Lrow).SpecialCells(xlCellTypeVisible).Formula = "=IFERROR(VLOOKUP(F" & fr & ",'Q&C Sampling'!A:C,3,FALSE),VLOOKUP(G" & fr & ",'Q&C Sampling'!A:C,3,FALSE))"
'*** Sat for Q&C Sampling
Range("AB" & fr & ":AB" & Lrow).SpecialCells(xlCellTypeVisible).Formula = "=IFERROR(VLOOKUP(F" & fr & ",'Q&C Sampling'!A:D,4,FALSE),VLOOKUP(G" & fr & ",'Q&C Sampling'!A:D,4,FALSE))"
'*** Cleansing Q&C sampling column
Range("AB2:AB" & Lrow).Copy
Range("AB2").PasteSpecial xlPasteValues
Range("a1").AutoFilter Field:=28, Criteria1:="#N/A"
Range("ab2:ab" & Lrow).SpecialCells(xlCellTypeVisible).Value = ""
'*** Part 7 COMPARING FINAL PLATE TIME AGAINT THE NEW TIME
Range("A1").AutoFilter Field:=26, Criteria1:="TRUE"
On Error GoTo 1
Range("M2:M" & Lrow).SpecialCells(xlCellTypeVisible).Value = "Achieved Call - Panellist Correct"
Range("N2:N" & Lrow).SpecialCells(xlCellTypeVisible).Value = "Not Required"
Range("W2:W" & Lrow).SpecialCells(xlCellTypeVisible).Value = "Other"
1:
'**** PART 8 changing the outcomes of Q&C Sampling
Range("a1").AutoFilter Field:=28, Criteria1:="TRUE"
Range("a1").AutoFilter Field:=24, Criteria1:="Outstanding"
On Error GoTo 2
Range("M2:M" & Lrow).SpecialCells(xlCellTypeVisible).Value = "Achieved Call - RM Correct"
Range("O2:O" & Lrow).SpecialCells(xlCellTypeVisible).Value = "Q&C Sampling"
2:
Range("a1").AutoFilter Field:=28, Criteria1:="FALSE"
'''THIS AREA NEEDS WORK *******
iRowcount = Application.WorksheetFunction.Subtotal(3, Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row))
If iRowcount > 1 Then
Else
End If
On Error GoTo 0
'**** Part 9 filtering on incorrect times
Columns("L:L").Insert
Range("L2").Formula = "=MINUTE(K2)"
Range("L2").NumberFormat = "0"
Range("l2").AutoFill Destination:=Range("L2:L" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("L2:L" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
Range("L2").PasteSpecial xlPasteValues
Columns("M:M").Insert
Range("M2").Formula = "=IF(OR(L2=0,L2=15,L2=30,L2=45),""T"",""F"")"
Range("M2").AutoFill Destination:=Range("M2:M" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("a1").AutoFilter Field:=13, Criteria1:="F"
Range("O2:O" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Value = "Achieved Call - RM Correct"
Range("P2:P" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Value = "Not Required"
Range("Q2:Q" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Value = "Non Scheduled time entered."
Columns("L:M").Delete
'**** last filter on outstanding
End Sub