Sub MasterPan()
cMonth = Application.InputBox("Please Enter the Current Month", "current Month", "October")
Today = Format(Date, "DD MMMM")
msheet = cMonth & " " & "Calls"
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\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)
MF = Application.GetOpenFilename(Title:=" Please open the latest Master File(call List)")
If MF = False Then Exit Sub
MrFil = Mid(MF, InStrRev(MF, "\") + 1, InStrRev(MF, "x") - InStrRev(MF, "\"))
Application.DisplayAlerts = False
Workbooks.Open (MF)
Application.DisplayAlerts = True
sqlresults = Application.GetOpenFilename(Title:=" Please Open the latest SQL Results")
sResults = Mid(sqlresults, InStrRev(sqlresults, "\") + 1, InStrRev(sqlresults, "x") - InStrRev(sqlresults, "\"))
Workbooks.Open (sqlresults)
Workbooks(sResults).Sheets(1).Range("a1").CurrentRegion.Copy
Workbooks(MrFil).Activate
Sheets.Add after:=Sheets(1)
ActiveSheet.Name = Today
Range("a1").PasteSpecial xlPasteAll
Workbooks(sResults).Close savechanges:=False
Workbooks(MrFil).Sheets("08 November").Activate ''used to copy heading format you can use any other sheet if this part fails
Range("J1:M1").Copy
Sheets(Today).Range("J1").PasteSpecial xlPasteAll
Sheets(Today).Activate
''''''filling column "J" (in current month)
Range("j2").Formula = "=IFERROR(VLOOKUP(C2,'" & cMonth & " Calls'!$F:$F,1,FALSE),"""")"
Range("j2").AutoFill Destination:=Range("j2:j" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("j2:j" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
Range("j2").PasteSpecial xlPasteValues
''''''filling column "K" ( photo evidence)
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\CODOL ISSUE June 2015\Pans Updated LATs\YTD LAT calls"
LATPhotoEvidence = Application.GetOpenFilename(Title:="Please Select 00-Pan Updated LATs Calls YTD Pan&RM correct.xlsx")
If LATPhotoEvidence = False Then
MsgBox ("You must choose a file, Exiting")
Exit Sub
Else
Workbooks.Open (LATPhotoEvidence)
End If
lphoto = Mid(LATPhotoEvidence, InStrRev(LATPhotoEvidence, "\") + 1, InStrRev(LATPhotoEvidence, "x") - InStrRev(LATPhotoEvidence, "\"))
Workbooks(MrFil).Sheets(Today).Activate
Range("k2").Formula = "=IFERROR(VLOOKUP(C2,'[00 - Pan Updated LATs Calls YTD Pan&RM correct.xlsx]LATs with photos'!$F:$R,13,FALSE),"""")"
Range("k2").AutoFill Destination:=Range("k2:k" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("k2:k" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
Range("k2").PasteSpecial xlPasteValues
Workbooks(lphoto).Close savechanges:=False
''''''''''''''Fillin column L''''''''''''''''''''''''''''''
sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\CODOL ISSUE June 2015\Pans Updated LATs\YTD LAT calls\LAT updates from RM"
RoyalMailError = Application.GetOpenFilename(Title:="Please select 00 - Sampled Boxes Updated by Panellists - ALL.xlsx")
RMerror = Mid(RoyalMailError, InStrRev(RoyalMailError, "\") + 1, InStrRev(RoyalMailError, "x") - InStrRev(RoyalMailError, "\"))
Workbooks.Open (RoyalMailError)
Range("L2").Formula = "=IFERROR(VLOOKUP(C2,'[00 - Sampled Boxes Updated by Panellists - ALL.xlsx]RM error'!$B:$K,10,FALSE),"""")"
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
Workbooks(RMerror).Close savechanges:=False
''''''''getting data from black list'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
blacklist = Application.GetOpenFilename(Title:="Please select the latest black List")
BlackListLook = Mid(blacklist, InStrRev(blacklist, "\") + 1, InStrRev(blacklist, "x") - InStrRev(blacklist, "\"))
Workbooks.Open (BlackListLook)
Columns("M:M").Insert
Range("M1").Value = "BlackList Boxes"
Range("l1").Copy
Range("m1").PasteSpecial xlPasteFormats
Range("m2").Formula = "=IFERROR(VLOOKUP(C2,'[" & BlackListLook & "]Master'!$B:$B,1,FALSE),"""")"
Range("m2").AutoFill Destination:=Range("m2:m" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("m2:m" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
Range("m2").PasteSpecial xlPasteValues
Workbooks(BlackListLook).Close savechanges:=False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Range("a1").AutoFilter Field:=10, Criteria1:=""
Range("a1").AutoFilter Field:=11, Criteria1:=""
Range("a1").AutoFilter Field:=12, Criteria1:=""
Range("a1").AutoFilter Field:=13, Criteria1:=""
Range("N2:N" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Value = "Chase"
''''''''''''''''''''''''''''copying data into the crntMonth calls
Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
Sheets(msheet).Range("c2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Range("i2:I" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
Sheets(msheet).Range("D2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Range("b2:b" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
Sheets(msheet).Range("E2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
Sheets(msheet).Range("F2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Range("D2:D" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
Sheets(msheet).Range("H2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Range("E2:E" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
Sheets(msheet).Range("I2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Range("F2:H" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
Sheets(msheet).Range("J2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Workbooks(MrFil).Sheets(msheet).Activate
r = Range("g1").End(xlDown).Offset(1, 0).Row
fVar = "F" & r
Range("G" & r).Formula = "=" & fVar & "&""""&""D"""
l = Range("f1").End(xlDown).Row
Range("g" & r).AutoFill Destination:=Range("g" & r & ":G" & l)
Range("g" & r & ":G" & l).Copy
Range("g" & r).PasteSpecial xlPasteValues
Range("b" & r & ":b" & l).Value = 1
Range("B:B").NumberFormat = "0"
Range("A" & r & ":A" & l).Value = Date
Range("A3:V3").Copy
Range("A" & r & ":V" & l).PasteSpecial xlPasteFormats
''''''copying the drop downs and formulas
Range("M" & r & ":M" & l).Select
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Q&C Sampling'!$K$1:$K$6"
End With
Range("N" & r & ":N" & l).Select
xlBetween, Formula1:="='Q&C Sampling'!$L$1:$L$2"
Range("S" & r & ":S" & l).Select
xlBetween, Formula1:="='Q&C Sampling'!$M$1:$M$4"
Range("V" & r & ":V" & l).Select
xlBetween, Formula1:="='Q&C Sampling'!$N$1:$N$4"
'''''''''''''''''''''''''''''''''''''''''
n = r - 1
Range("W" & n).AutoFill Destination:=Range("W" & n & ":W" & l)
Range("AB" & r - 1).AutoFill Destination:=Range("AB" & n & ":AB" & l)
Range("W3:AB3").Copy
Range("W" & r & ":AB" & l).PasteSpecial xlPasteFormats
Range("AC" & n & ":AD" & n).AutoFill Destination:=Range("Ac" & n & ":AD" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("X" & n).AutoFill Destination:=Range("X" & n & ":x" & Cells(Rows.Count, 1).End(xlUp).Row)
End Sub