Sub bsi()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
lsunday = Application.InputBox("Enter the first Sunday before the current period as date", "Previous Period Sunday", "01 May 2016")
Script = Sheets("script").Range("a1").Value
strsql = Script & "'" & lsunday & "'"
nsheet = Format(Date, "dd.mm.yy") & " " & "BSI"
pvt = "Pivot " & Format(Date, "dd.mm")
TSB = "TSB SouthHampton" & Format(Date, "dd.mm.yy")
BSILA = "BSI Lloyds Andover" & Format(Date, "dd.mm.yy")
BSIED = "BSI Edinborough" & Format(Date, "dd.mm.yy")
BSIEDRS = "BSI Edinorough RS " & Format(Date, "dd.mm.yy")
Set cn = New ADODB.Connection
cn.CommandTimeout = 0
cn.Open "Provider=sqloledb.1;Data Source= TSMLPRDB001.PUB.RESEARCH-INT.COM\TSMLPRDB001A ;Initial Catalog= ConsigniaSurveysCopy ;Integrated Security=SSPI"
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenForwardOnly
rs.Open strsql, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF Then
MsgBox "Seems like SQL is not working" & vbNewLine & " You may want to raise a shrepoint !!!", vbInformation + vbOKOnly, ":("
Exit Sub
Else
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = nsheet
For Each x In rs.Fields
Range("a1").Offset(0, y).Value = x.Name
y = y + 1
Next x
End If
Range("a2").CopyFromRecordset rs
Columns("I:M").AutoFit
Columns("I:M").NumberFormat = "dd/mm/yyyy"
''''''''''''''''''''''''''''''Pivot table filters''''''''''''''''''''''''
Set objtable = Sheets(nsheet).PivotTableWizard(tablename:="BSI")
ActiveSheet.Name = pvt
Set objfield = objtable.PivotFields("DMFstatusID")
objfield.Orientation = xlPageField
objfield.PivotItems("3").Visible = False
objfield.PivotItems("4").Visible = False
objfield.PivotItems("5").Visible = False
EnableMultiplePageItems = True
Set objfield = objtable.PivotFields("ActualSurveysID")
objfield.PivotItems("35").Visible = False
objfield.PivotItems("36").Visible = False
Set objfield = objtable.PivotFields("BSIBoxNumber")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set objfield = objtable.PivotFields("DateOfReceipt")
objfield.Orientation = xlRowField
Set objfield = objtable.PivotFields("ClassOfMailid")
objfield.Orientation = xlColumnField
Set objfield = objtable.PivotFields("OnTimeYN")
Set objfield = objtable.PivotFields("ItemID")
objfield.Orientation = xlDataField
objfield.Function = xlCount
'''''''''''''''''''''''''''''''''''''''''''''BSI Lloyds andover'''''''''
Sheets(pvt).Range("a8").CurrentRegion.Copy
ActiveSheet.Name = BSILA
Range("a1").PasteSpecial xlPasteValues
Columns("E:E").Insert
Columns("I:I").Insert
Range("e4").Formula = "=C4/D4"
Range("e4").AutoFill Destination:=Range("e4:e" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("e4:e" & Cells(Rows.Count, 1).End(xlUp).Row).NumberFormat = "0.00%"
Range("I4").Formula = "=G4/H4"
Range("I4").AutoFill Destination:=Range("I4:I" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("I3:I" & Cells(Rows.Count, 1).End(xlUp).Row).NumberFormat = "0.00%"
Range("b1:d1").Value = "1C"
Range("b2").Value = "N"
Range("c2").Value = "Y"
Range("e2").Value = "1c QofS"
Range("f1:h1").Value = "2C"
Range("f1:h1").WrapText = True
Range("F2").Value = "N"
Range("G2").Value = "Y"
Range("I2").Value = "2c QofS"
Range("A:A").NumberFormat = "DD/mm/yyyy"
Range("c3").Select
Selection.CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
With Selection.Borders(xlEdgeBottom)
With Selection.Borders(xlEdgeRight)
With Selection.Borders(xlInsideVertical)
With Selection.Borders(xlInsideHorizontal)
'''''''''''''''''''''''''''''''''TSB SouthHampton''''''''''''''''''''
Sheets(pvt).Activate
objfield.PivotItems("4").Visible = True
objfield.PivotItems("1").Visible = False
objfield.PivotItems("2").Visible = False
objfield.PivotItems("97").Visible = False
objfield.PivotItems("98").Visible = False
objfield.PivotItems("99").Visible = False
objfield.PivotItems("100").Visible = False
objfield.PivotItems("101").Visible = False
objfield.PivotItems("102").Visible = False
Sheets(pvt).Range("C5").CurrentRegion.Copy
ActiveSheet.Name = TSB
''''''''''''''''''''''''''''''''TSB SouthHampton'''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''BSI Edinborough'''''''''''''''''''''''
objfield.PivotItems("1").Visible = True
objfield.PivotItems("2").Visible = True
objfield.PivotItems("3").Visible = True
objfield.PivotItems("5").Visible = True
objfield.PivotItems("97").Visible = True
objfield.PivotItems("98").Visible = True
objfield.PivotItems("99").Visible = True
objfield.PivotItems("100").Visible = True
objfield.PivotItems("101").Visible = True
objfield.PivotItems("102").Visible = True
objfield.PivotItems("35").Visible = True
objfield.PivotItems("14").Visible = False
ActiveSheet.Name = BSIED
'''''''''''''''''''BSI Edinborough RS''''''''''''''''''''''''''''''''''''''
objfield.PivotItems("36").Visible = True
ActiveSheet.Name = BSIEDRS
If Range("f2").Value <> "Grand Total" Then
Results = MsgBox("Did you get what you were looking for ?", vbYesNo)
If Results = vbYes Then
MsgBox " We are glad you got what you were looking for ," & vbNewLine & " *****We wish you a productive day ahead*****"
MsgBox " ***We apologise for this inconvenience***" & vbNewLine & "Please Email mostaf.nejad@dummy.com for further information and feedback", vbMsgBoxHelpButton, "OOOPS !"
End Sub