Sub DBtableFormat()
'
' DBtableFormat Macro
' Converts db exports to tables
'
'
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'convert source data to table
If ws.Name = "BUTTON" Then
Else
ws.Activate
ActiveSheet.Range("A1").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range(Selection, Selection.SpecialCells(xlLastCell)), , xlYes).Name _
= "ReqVol" & ws.Index + 3
'Range("tableReq[#All]").Select
ActiveSheet.ListObjects(1).TableStyle = "TableStyleLight14"
End If
Next ws
' newDataSheet Macro
' adds new datasheet to workbook
'
'
Dim wbsList As String
'WBS listing
'wbsList = "YC.PR.AAA YE.ST.ACN ALL"
wbsList = "YC.PR.AAA YC.DP.AAA YE.ST.ACN YE.US.ACN YE.BB.SHQ YE.EE.SHQ YE.ST.SHQ YE.BB.DSQ YE.ST.DSQ YE.BB.MUS YW.BB.MUS YW.ST.ADB YW.SB.ADB YW.BB.ADB YW.ST.SAC YW.BB.SAC YW.ST.SAD YW.BB.SAD YW.ST.SAS YW.SB.SAS YW.BB.SAS YW.ST.WAC YW.BB.WAC YW.ST.SPC YW.SB.SPC YW.BB.SPC YW.ST.VIL YW.BB.VIL YW.ST.ZOO YW.BB.ZOO YW.ST.RYS YW.BB.RYS YW.ST.MUA YW.TB.MUA YW.BB.MUA"
Dim wbsArray() As String
wbsArray() = Split(wbsList)
'repeat for each location
'add charts sheet
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = "CHARTS"
ActiveSheet.Range("A1") = "WBS code"
ActiveSheet.Range("B1") = "Total Requirements"
ActiveSheet.Range("C1") = "Requirements Complied"
ActiveSheet.Range("D1") = "Requirements Compliance Blank"
ActiveSheet.Range("E1") = "Total PMM's"
ActiveSheet.Range("F1") = "PMM's Complied"
ActiveSheet.Range("G1") = "PMM Compliance Blank"
ActiveSheet.Range("I2") = "Requirements"
ActiveSheet.Range("I3") = "Req.Compliances"
ActiveSheet.Range("I4") = "PMM's"
ActiveSheet.Range("I5") = "PMM Compliances"
ActiveSheet.Range("J1") = "Volume-4"
ActiveSheet.Range("J2") = "=+COUNTIF('V4'!C[-4],""Requirement"")"
ActiveSheet.Range("J3") = "=+COUNTIF('V4'!C[-4],""Req.Compliances"")"
ActiveSheet.Range("J4") = "=+COUNTIF('V4'!C[-4],""Process Method Management"")"
ActiveSheet.Range("J5") = "=+COUNTIF('V4'!C[-4],""Process Method Management compliances"")"
ActiveSheet.Range("K1") = "Volume-5"
ActiveSheet.Range("K2") = "=+COUNTIF('V5'!C[-5],""Requirement"")"
ActiveSheet.Range("K3") = "=+COUNTIF('V5'!C[-5],""Req.Compliances"")"
ActiveSheet.Range("K4") = "=+COUNTIF('V5'!C[-5],""Process Method Management"")"
ActiveSheet.Range("K5") = "=+COUNTIF('V5'!C[-5],""Process Method Management compliances"")"
ActiveSheet.Range("L1") = "Volume-6"
ActiveSheet.Range("L2") = "=+COUNTIF('V6'!C[-6],""Requirement"")"
ActiveSheet.Range("L3") = "=+COUNTIF('V6'!C[-6],""Req.Compliances"")"
ActiveSheet.Range("L4") = "=+COUNTIF('V6'!C[-6],""Process Method Management"")"
ActiveSheet.Range("L5") = "=+COUNTIF('V6'!C[-6],""Process Method Management compliances"")"
ActiveSheet.Range("M1") = "Volume-7"
ActiveSheet.Range("M2") = "=+COUNTIF('V7'!C[-7],""Requirement"")"
ActiveSheet.Range("M3") = "=+COUNTIF('V7'!C[-7],""Req.Compliances"")"
ActiveSheet.Range("M4") = "=+COUNTIF('V7'!C[-7],""Process Method Management"")"
ActiveSheet.Range("M5") = "=+COUNTIF('V7'!C[-7],""Process Method Management compliances"")"
ActiveSheet.Range("O1") = "FBS Code"
ActiveSheet.Range("O2") = "CIV-ALI"
ActiveSheet.Range("O3") = "CIV-ARC-EXT"
ActiveSheet.Range("O4") = "CIV-ARC-STN"
ActiveSheet.Range("O5") = "CIV-ATG"
ActiveSheet.Range("O6") = "CIV-CSD"
ActiveSheet.Range("O7") = "CIV-ENA"
ActiveSheet.Range("O8") = "CIV-LSC"
ActiveSheet.Range("O9") = "CIV-MEP"
ActiveSheet.Range("O10") = "CIV-STN"
ActiveSheet.Range("O11") = "CIV-STR"
ActiveSheet.Range("O12") = "CIV-TUN"
ActiveSheet.Range("O13") = "INF-EXT"
ActiveSheet.Range("O14") = "INF-INT"
ActiveSheet.Range("O15") = "EMT"
ActiveSheet.Range("O16") = "HSE"
ActiveSheet.Range("O17") = "PMT"
ActiveSheet.Range("O18") = "QMS"
ActiveSheet.Range("O19") = "ROP-MNT"
ActiveSheet.Range("O20") = "SSA"
ActiveSheet.Range("O21") = "SYS-ENG"
ActiveSheet.Range("P1") = "No.Requirements"
ActiveSheet.Range("Q1") = "No.PMM's"
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$" & UBound(wbsArray()) + 2), , xlYes).Name = "table_TOTALS"
Range("table_TOTALS").Select
ActiveSheet.ListObjects(1).ShowTotals = True
ActiveSheet.ListObjects(1).ListColumns("Total Requirements").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("Requirements Complied").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("Requirements Compliance Blank").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("Total PMM's").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("PMM's Complied").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("PMM Compliance Blank").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$I$1:$M$5"), , xlYes).Name = _
"table_Volumes"
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$O$1:$Q$21"), , xlYes).Name = _
"table_FBS"
Columns("I").EntireColumn.AutoFit
Columns("O").EntireColumn.AutoFit
Range("H:H,N:N").ColumnWidth = 3
Dim locno As Integer
locno = 2
For Each wrd In wbsArray()
Dim loc As String
loc = wrd
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = loc
ActiveCell.FormulaR1C1 = "WBS"
ActiveSheet.Range("B1") = loc
Range("B1").Select
'ActiveWorkbook.Names.Add Name:="wbs" & loc, RefersToR1C1:="=" & ActiveSheet.Name & "!B1"
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With
'first table headings
ActiveSheet.Range("A3") = "Discipline"
ActiveSheet.Range("B3") = "FBS code"
ActiveSheet.Range("C3") = "No.Requirements"
ActiveSheet.Range("D3") = "Design Compliance Statement"
ActiveSheet.Range("E3") = "DS1 Ready"
ActiveSheet.Range("F3") = "DS1 Non Compliances"
ActiveSheet.Range("G3") = "DS1 Status"
ActiveSheet.Range("H3") = "DS2 Ready"
ActiveSheet.Range("I3") = "DS2 Non Compliances"
ActiveSheet.Range("J3") = "DS2 Status"
ActiveSheet.Range("K3") = "Total Agreed Validation"
ActiveSheet.Range("L3") = "Validation Compliance Statement"
ActiveSheet.Range("M3") = "Validation Status"
ActiveSheet.Range("N3") = "DCS"
ActiveSheet.Range("O3") = "VCS"
ActiveSheet.Range("P3") = "CS Blank"
ActiveSheet.Range("Q3") = "VS Blank"
'rows
ActiveSheet.Range("A4") = "Alignment"
ActiveSheet.Range("B4") = "CIV-ALI"
ActiveSheet.Range("A5") = "Architecture External"
ActiveSheet.Range("B5") = "CIV-ARC-EXT"
ActiveSheet.Range("A6") = "Architecture Station"
ActiveSheet.Range("B6") = "CIV-ARC-STN"
ActiveSheet.Range("A7") = "At Grade"
ActiveSheet.Range("B7") = "CIV-ATG"
ActiveSheet.Range("A8") = "Combined Services"
ActiveSheet.Range("B8") = "CIV-CSD"
ActiveSheet.Range("A9") = "Geotechnical"
ActiveSheet.Range("B9") = "CIV-ENA"
ActiveSheet.Range("A10") = "Landscaping"
ActiveSheet.Range("B10") = "CIV-LSC"
ActiveSheet.Range("A11") = "MEP"
ActiveSheet.Range("B11") = "CIV-MEP"
ActiveSheet.Range("A12") = "Station"
ActiveSheet.Range("B12") = "CIV-STN"
ActiveSheet.Range("A13") = "Structure"
ActiveSheet.Range("B13") = "CIV-STR"
ActiveSheet.Range("A14") = "Tunnel"
ActiveSheet.Range("B14") = "CIV-TUN"
ActiveSheet.Range("A15") = "External Interface"
ActiveSheet.Range("B15") = "INF-EXT"
ActiveSheet.Range("A16") = "Internal Interface"
ActiveSheet.Range("B16") = "INF-INT"
ActiveSheet.Range("A17") = "Engineering Management"
ActiveSheet.Range("B17") = "EMT"
ActiveSheet.Range("A18") = "Fire Life Safety"
ActiveSheet.Range("B18") = "HSE"
ActiveSheet.Range("A19") = "Project Management"
ActiveSheet.Range("B19") = "PMT"
ActiveSheet.Range("A20") = "Quality Management"
ActiveSheet.Range("B20") = "QMS"
ActiveSheet.Range("A21") = "O&M Management"
ActiveSheet.Range("B21") = "ROP-MNT"
ActiveSheet.Range("A22") = "Systems Assurance"
ActiveSheet.Range("B22") = "SSA"
ActiveSheet.Range("A23") = "Systems Engineering"
ActiveSheet.Range("B23") = "SYS-ENG"
'make table
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$3:$Q$23"), , xlYes).Name = _
"table_R" & loc
Range("Table_R" & loc & "[#All]").Select
ActiveSheet.ListObjects("Table_R" & loc).TableStyle = "TableStyleMedium7"
ActiveSheet.ListObjects(1).ShowTotals = True
ActiveSheet.ListObjects(1).ListColumns("No.Requirements").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("Total Agreed Validation").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("DCS").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("VCS").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("CS Blank").TotalsCalculation = xlTotalsCalculationSum
'add formatting
'Range("table_RALL[[Design Compliance Statement]:[Validation Status]]").Select
Range("D4:J23").Select
Selection.Style = "Percent"
Selection.FormatConditions.AddColorScale ColorScaleType:=2
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValuePercent
Selection.FormatConditions(1).ColorScaleCriteria(1).Value = 0
Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor.ThemeColor = xlThemeColorAccent2
Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor.TintAndShade = 0.6
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercent
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 100
Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor.ThemeColor = xlThemeColorAccent3
Range("L4:M23").Select
Selection.Style = "Percent"
Selection.FormatConditions.AddColorScale ColorScaleType:=2
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValuePercent
Selection.FormatConditions(1).ColorScaleCriteria(1).Value = 0
Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor.ThemeColor = xlThemeColorAccent2
Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor.TintAndShade = 0.6
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercent
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 100
Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor.ThemeColor = xlThemeColorAccent3
Columns("A:M").EntireColumn.AutoFit
Range("A3:M3").WrapText = True
Range("3:3").RowHeight = 30
Range("A:A").ColumnWidth = 24
Range("C:C").ColumnWidth = 16
Range("D:D").ColumnWidth = 17
Range("E:E,G:G,H:H,J:J").ColumnWidth = 10
Range("B:B,F:F,I:I,K:K").ColumnWidth = 12
Range("L:L").ColumnWidth = 20
Range("M:M").ColumnWidth = 16
Range("A3:B3").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Range("C3:M3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'second table
Range("A2:Q24").Select
Selection.Copy
Range("A25").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("C26") = "No.PMM's"
ActiveSheet.ListObjects(2).TableStyle = "TableStyleMedium6"
ActiveSheet.ListObjects(2).DisplayName = "TableP_" & loc
ActiveSheet.ListObjects(2).ShowTotals = True
Range("26:26").RowHeight = 30
' set up printing
With ActiveSheet.PageSetup
.PrintArea = ActiveSheet.Range("A1:M47").Address
.Orientation = xlLandscape
.FitToPagesWide = 1
.CenterHeader = "Requirements Status Summary"
.CenterFooter = "&A"
.RightFooter = "&D"
.PaperSize = xlPaperA3
End With
Range("B2").Select
Call populateTable("Requirement", 1, "No.Requirements")
Call populateTable("Process Method Management", 2, "No.PMM's")
'copy data into charts sheet
Worksheets("CHARTS").Range("A" & locno) = loc
Worksheets("CHARTS").Range("B" & locno) = ActiveSheet.ListObjects(1).ListColumns("No.Requirements").Total.Value
Worksheets("CHARTS").Range("E" & locno) = ActiveSheet.ListObjects(2).ListColumns("No.PMM's").Total.Value
Worksheets("CHARTS").Range("D" & locno) = ActiveSheet.ListObjects(1).ListColumns("CS Blank").Total.Value
Worksheets("CHARTS").Range("G" & locno) = ActiveSheet.ListObjects(2).ListColumns("CS Blank").Total.Value
Worksheets("CHARTS").Range("C" & locno) = ActiveSheet.ListObjects(1).ListColumns("DCS").Total.Value
Worksheets("CHARTS").Range("F" & locno) = ActiveSheet.ListObjects(2).ListColumns("DCS").Total.Value
Sheets("CHARTS").Select
Range("G39").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C[-5],R[-2]C[-2])"
Range("B38").Select
ActiveCell.FormulaR1C1 = _
"=table_TOTALS[[#Totals],[Total Requirements]]/R[1]C[5]"
Range("C38").Select
ActiveCell.FormulaR1C1 = _
"=table_TOTALS[[#Totals],[Requirements Complied]]/R[1]C[4]"
Range("D38").Select
ActiveCell.FormulaR1C1 = _
"=table_TOTALS[[#Totals],[Requirements Compliance Blank]]/R[1]C[3]"
Range("E38").Select
ActiveCell.FormulaR1C1 = "=table_TOTALS[[#Totals],[Total PMM''s]]/R[1]C[2]"
Range("F38").Select
ActiveCell.FormulaR1C1 = "=table_TOTALS[[#Totals],[PMM''s Complied]]/R[1]C[1]"
Range("G38").Select
Calculate
ActiveCell.FormulaR1C1 = _
"=table_TOTALS[[#Totals],[PMM Compliance Blank]]/R[1]C"
Range("G39").Select
Range("B38:G38").Select
Selection.NumberFormat = "0.00%"
locno = locno + 1
Next wrd
Sheets("CHARTS").Select
Range("P2:P21") = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
Range("Q2:Q21") = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
' Macro1 Macro
'
'
'add GRAPHS sheet
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = "GRAPHS"
Cells.Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'
'
' Macro2 Macro
'
'
Sheets("CHARTS").Select
Range("table_Volumes[#All]").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("CHARTS!$I$1:$M$5")
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "REQUIREMENTS BY ER'S VOLUMES"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"REQUIREMENTS BY ER'S VOLUMES"
With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
ActiveChart.PlotArea.Select
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 203
ActiveChart.SetElement (msoElementDataLabelCenter)
ActiveChart.FullSeriesCollection(3).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.FullSeriesCollection(3).DataLabels.Select
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
Selection.Orientation = xlDownward
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsObject, Name:="GRAPHS"
'
' Macro3 Macro
'
'
Sheets("CHARTS").Select
Sheets("CHARTS").Name = "CHARTS"
Sheets("CHARTS").Select
Range("table_FBS[#All]").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("CHARTS!$O$1:$Q$21")
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 203
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "REQUIREMENT'S BY WBS CODE"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"REQUIREMENT'S BY WBS CODE"
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).Font
End With
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementDataLabelCenter)
ActiveChart.FullSeriesCollection(2).DataLabels.Select
ActiveChart.PlotArea.Select
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(2).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(1).DataLabels.Select
ActiveChart.FullSeriesCollection(2).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.BaselineOffset = 0.02
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.BaselineOffset = 0.02
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsObject, Name:="GRAPHS"
'
' Macro4 Macro
'
'
Sheets("CHARTS").Select
Range("table_TOTALS[[#Headers],[#Data]]").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("CHARTS!$A$1:$G$37")
ActiveChart.FullSeriesCollection(2).IsFiltered = True
ActiveChart.FullSeriesCollection(3).IsFiltered = True
ActiveChart.FullSeriesCollection(5).IsFiltered = True
ActiveChart.FullSeriesCollection(6).IsFiltered = True
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "REQUIREMENT'S BY FBS CODE"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"REQUIREMENT'S BY FBS CODE"
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).Font
End With
ActiveChart.ChartArea.Select
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 203
ActiveChart.SetElement (msoElementDataLabelCenter)
ActiveChart.FullSeriesCollection(4).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.PlotArea.Select
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(4).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.BaselineOffset = 0.01
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.BaselineOffset = 0.01
ActiveChart.PlotArea.Select
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsObject, Name:="GRAPHS"
ActiveWindow.SmallScroll Down:=9
'
' Macro5 Macro
'
'
Range("B55").Select
Sheets("GRAPHS").Select
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(1).Values = "=CHARTS!$B$38,CHARTS!$E$38"
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "Requirements Summary"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Requirements Summary"
With Selection.Format.TextFrame2.TextRange.Characters(1, 20).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 12).Font
End With
With Selection.Format.TextFrame2.TextRange.Characters(13, 8).Font
End With
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementDataLabelBestFit)
Range("K61").Select
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(1).Values = _
"=CHARTS!$C$38,CHARTS!$D$38,CHARTS!$F$38,CHARTS!$G$38"
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "Compliance Statement Summary"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"Compliance Statement Summary"
With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementDataLabelBestFit)
Sheets("GRAPHS").Select
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 5").IncrementLeft -488.25
ActiveSheet.Shapes("Chart 5").IncrementTop 3.75
ActiveSheet.Shapes("Chart 5").ScaleHeight 1.4600696267, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 5").ScaleWidth 1.2291666667, msoFalse, _
msoScaleFromTopLeft
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 4").ScaleHeight 1.4704862934, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 4").IncrementLeft 4.5
ActiveSheet.Shapes("Chart 4").IncrementTop 1.5
ActiveSheet.Shapes("Chart 4").ScaleWidth 1.1229166667, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveSheet.Shapes("Chart 3").IncrementLeft -509.25
ActiveSheet.Shapes("Chart 3").IncrementTop -167.25
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveSheet.Shapes("Chart 3").ScaleWidth 1.7520833333, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveSheet.Shapes("Chart 3").ScaleHeight 1.8454862934, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveSheet.Shapes("Chart 3").ScaleWidth 1.0535076041, msoFalse, _
msoScaleFromBottomRight
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 2").IncrementLeft 211.5
ActiveSheet.Shapes("Chart 2").IncrementTop -160.5
ActiveSheet.Shapes("Chart 2").ScaleWidth 1.7125, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 2").ScaleHeight 1.6336807378, msoFalse, _
msoScaleFromTopLeft
ActiveChart.ChartTitle.Select
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.PlotArea.Select
Selection.Left = 39.089
Selection.Top = 60.85
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartTitle.Select
ActiveChart.PlotArea.Select
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.PlotArea.Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").IncrementLeft -67.5
ActiveSheet.Shapes("Chart 1").IncrementTop 214.5
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.6875, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.1703703704, msoFalse, _
msoScaleFromBottomRight
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.3038196267, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").IncrementLeft -19.5
ActiveSheet.Shapes("Chart 1").IncrementTop 46.5
End Sub
Sub populateTable(category As String, tableID As Integer, colHeading As String)
Dim tblTarget As ListObject
Dim tblSource As ListObject
Dim tRows As Integer
Dim sRows As Integer
Dim discipline As String
Dim wbs As String
Dim tRw As Integer
Dim sRw As Integer
'count variables
Dim cRequ As Integer
Dim cDCbl As Integer
Dim cDS1r As Integer
Dim cDS1n As Integer
Dim cDS1s As Integer
Dim cDS2r As Integer
Dim cDS2n As Integer
Dim cDS2s As Integer
Dim cVdag As Integer
Dim cVdcs As Integer
Dim cVdst As Integer
Set tblTarget = ActiveSheet.ListObjects(tableID)
tRows = tblTarget.DataBodyRange.Rows.Count
wbs = Range("B1").Value
'wbs = "xxx.xxx"
'loop through all rows in target table
For tRw = 1 To tRows
'reset counters
cRequ = 0
cDCbl = 0
cDCSt = 0
cDS1r = 0
cDS1n = 0
cDS1s = 0
cDS2r = 0
cDS2n = 0
cDS2s = 0
cVdbl = 0
cVdag = 0
cVdcs = 0
cVdst = 0
'get discipline name
discipline = tblTarget.ListColumns("FBS code").DataBodyRange.Rows(tRw)
'loop through all source tables
Dim v As Integer
For v = 2 To 5 'change here
Set tblSource = Worksheets(v).ListObjects(1)
sRows = tblSource.DataBodyRange.Rows.Count
'loop through individual source table
For sRw = 1 To sRows
'baseslab submission
'If InStr(tblSource.ListColumns("Contractor Comment").DataBodyRange.Rows(sRw), "BASESLAB") Then
'check if Atkins Internal Apportionment
'If tblSource.ListColumns("Contractor Internal Apportionment").DataBodyRange.Rows(sRw) = "ATKINS" Then
'check discipline matches & requirement/process variable
Dim cpFBS As String
cpFBS = tblSource.ListColumns("FBS").DataBodyRange.Rows(sRw)
If InStr(cpFBS, discipline) _
And tblSource.ListColumns("Category").DataBodyRange.Rows(sRw) = category Then
'''''''And tblSource.ListColumns("QR Identification").DataBodyRange.Rows(sRw) = "Tracked Requirement"
'check wbs2 matches
Dim wbs2 As String
wbs2 = tblSource.ListColumns("WBS2").DataBodyRange.Rows(sRw)
'check for match on type of WBS
If InStr(wbs2, wbs) Or wbs = "YC.PR.AAA" Then
'increment requirement cat count
cRequ = cRequ + 1
'check Design Compliance Statement blank
If tblSource.ListColumns("Design Compliance Statement").DataBodyRange.Rows(sRw) = "" Then
cDCbl = cDCbl + 1
'else check DS1 & DS2
Else
cDCSt = cDCSt + 1
'DS1 ready
Dim ds1r As String
ds1r = tblSource.ListColumns("DS1 Verification Request for Location").DataBodyRange.Rows(sRw)
If InStr(ds1r, wbs) Then
cDS1r = cDS1r + 1
End If
'DS2 ready
Dim ds2r As String
ds2r = tblSource.ListColumns("DS2 Verification Request for Location").DataBodyRange.Rows(sRw)
If InStr(ds2r, wbs) Then
cDS2r = cDS2r + 1
End If
'Design non-compliance
'DS1 non-compliance
Dim ds1n As String
ds1n = tblSource.ListColumns("DS1 Non-Compliant for Location").DataBodyRange.Rows(sRw)
If InStr(ds1n, wbs) Then
cDS1n = cDS1n + 1
End If
'DS2 non-compliance
Dim ds2n As String
ds2n = tblSource.ListColumns("DS2 Non-Compliant for Location").DataBodyRange.Rows(sRw)
If InStr(ds2n, wbs) Then
cDS2n = cDS2n + 1
End If
'Design Status
'DS1 status
Dim ds1s As String
ds1s = tblSource.ListColumns("DS1 Status").DataBodyRange.Rows(sRw)
If InStr(ds1s, wbs) Then
cDS1s = cDS1s + 1
End If
'DS2 status
Dim ds2s As String
ds2s = tblSource.ListColumns("DS2 Status").DataBodyRange.Rows(sRw)
If InStr(ds2s, wbs) Then
cDS2s = cDS2s + 1
End If
'check Agreed Validation
If tblSource.ListColumns("Validation Required?").DataBodyRange.Rows(sRw) = "Validation Required" Then
cVdag = cVdag + 1
End If
'check Validation Compliance blank
If tblSource.ListColumns("Validation Compliance Statement").DataBodyRange.Rows(sRw) = "" Then
cVdbl = cVdbl + 1
Else
'Validation compliance statement
cVdcs = cVdcs + 1
'Validation Status
Dim dsvs As String
dsvs = tblSource.ListColumns("Validation Status").DataBodyRange.Rows(sRw)
If InStr(dsvs, wbs) Then
cVdst = cVdst + 1
End If
End If
End If
End If
End If
'End If
'End If
Next sRw
Next v
'write into sheets
'tblTarget.ListColumns(colHeading).DataBodyRange.Rows(tRw) = cRequ
'tblTarget.ListColumns("Total Agreed Validation").DataBodyRange.Rows(tRw) = cVdag
tblTarget.ListColumns("DCS").DataBodyRange.Rows(tRw) = cDCSt
tblTarget.ListColumns("VCS").DataBodyRange.Rows(tRw) = cVdcs
tblTarget.ListColumns("CS Blank").DataBodyRange.Rows(tRw) = cDCbl
tblTarget.ListColumns("VS Blank").DataBodyRange.Rows(tRw) = cVdbl
If cRequ > 0 Then
tblTarget.ListColumns(colHeading).DataBodyRange.Rows(tRw) = cRequ
tblTarget.ListColumns("Design Compliance Statement").DataBodyRange.Rows(tRw) = cDCSt / cRequ
tblTarget.ListColumns("DS1 Ready").DataBodyRange.Rows(tRw) = cDS1r / cRequ
tblTarget.ListColumns("DS1 Non Compliances").DataBodyRange.Rows(tRw) = cDS1n / cRequ
tblTarget.ListColumns("DS1 Status").DataBodyRange.Rows(tRw) = cDS1s / cRequ
tblTarget.ListColumns("DS2 Ready").DataBodyRange.Rows(tRw) = cDS2r / cRequ
tblTarget.ListColumns("DS2 Non Compliances").DataBodyRange.Rows(tRw) = cDS2n / cRequ
tblTarget.ListColumns("DS2 Status").DataBodyRange.Rows(tRw) = cDS2s / cRequ
End If
If cVdag > 0 Then
tblTarget.ListColumns("Total Agreed Validation").DataBodyRange.Rows(tRw) = cVdag
tblTarget.ListColumns("Validation Compliance Statement").DataBodyRange.Rows(tRw) = cVdcs / cVdag
tblTarget.ListColumns("Validation Status").DataBodyRange.Rows(tRw) = cVdst / cVdag
End If
Next tRw
End Sub
'
' DBtableFormat Macro
' Converts db exports to tables
'
'
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'convert source data to table
If ws.Name = "BUTTON" Then
Else
ws.Activate
ActiveSheet.Range("A1").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range(Selection, Selection.SpecialCells(xlLastCell)), , xlYes).Name _
= "ReqVol" & ws.Index + 3
'Range("tableReq[#All]").Select
ActiveSheet.ListObjects(1).TableStyle = "TableStyleLight14"
End If
Next ws
' newDataSheet Macro
' adds new datasheet to workbook
'
'
Dim wbsList As String
'WBS listing
'wbsList = "YC.PR.AAA YE.ST.ACN ALL"
wbsList = "YC.PR.AAA YC.DP.AAA YE.ST.ACN YE.US.ACN YE.BB.SHQ YE.EE.SHQ YE.ST.SHQ YE.BB.DSQ YE.ST.DSQ YE.BB.MUS YW.BB.MUS YW.ST.ADB YW.SB.ADB YW.BB.ADB YW.ST.SAC YW.BB.SAC YW.ST.SAD YW.BB.SAD YW.ST.SAS YW.SB.SAS YW.BB.SAS YW.ST.WAC YW.BB.WAC YW.ST.SPC YW.SB.SPC YW.BB.SPC YW.ST.VIL YW.BB.VIL YW.ST.ZOO YW.BB.ZOO YW.ST.RYS YW.BB.RYS YW.ST.MUA YW.TB.MUA YW.BB.MUA"
Dim wbsArray() As String
wbsArray() = Split(wbsList)
'repeat for each location
'add charts sheet
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = "CHARTS"
ActiveSheet.Range("A1") = "WBS code"
ActiveSheet.Range("B1") = "Total Requirements"
ActiveSheet.Range("C1") = "Requirements Complied"
ActiveSheet.Range("D1") = "Requirements Compliance Blank"
ActiveSheet.Range("E1") = "Total PMM's"
ActiveSheet.Range("F1") = "PMM's Complied"
ActiveSheet.Range("G1") = "PMM Compliance Blank"
ActiveSheet.Range("I2") = "Requirements"
ActiveSheet.Range("I3") = "Req.Compliances"
ActiveSheet.Range("I4") = "PMM's"
ActiveSheet.Range("I5") = "PMM Compliances"
ActiveSheet.Range("J1") = "Volume-4"
ActiveSheet.Range("J2") = "=+COUNTIF('V4'!C[-4],""Requirement"")"
ActiveSheet.Range("J3") = "=+COUNTIF('V4'!C[-4],""Req.Compliances"")"
ActiveSheet.Range("J4") = "=+COUNTIF('V4'!C[-4],""Process Method Management"")"
ActiveSheet.Range("J5") = "=+COUNTIF('V4'!C[-4],""Process Method Management compliances"")"
ActiveSheet.Range("K1") = "Volume-5"
ActiveSheet.Range("K2") = "=+COUNTIF('V5'!C[-5],""Requirement"")"
ActiveSheet.Range("K3") = "=+COUNTIF('V5'!C[-5],""Req.Compliances"")"
ActiveSheet.Range("K4") = "=+COUNTIF('V5'!C[-5],""Process Method Management"")"
ActiveSheet.Range("K5") = "=+COUNTIF('V5'!C[-5],""Process Method Management compliances"")"
ActiveSheet.Range("L1") = "Volume-6"
ActiveSheet.Range("L2") = "=+COUNTIF('V6'!C[-6],""Requirement"")"
ActiveSheet.Range("L3") = "=+COUNTIF('V6'!C[-6],""Req.Compliances"")"
ActiveSheet.Range("L4") = "=+COUNTIF('V6'!C[-6],""Process Method Management"")"
ActiveSheet.Range("L5") = "=+COUNTIF('V6'!C[-6],""Process Method Management compliances"")"
ActiveSheet.Range("M1") = "Volume-7"
ActiveSheet.Range("M2") = "=+COUNTIF('V7'!C[-7],""Requirement"")"
ActiveSheet.Range("M3") = "=+COUNTIF('V7'!C[-7],""Req.Compliances"")"
ActiveSheet.Range("M4") = "=+COUNTIF('V7'!C[-7],""Process Method Management"")"
ActiveSheet.Range("M5") = "=+COUNTIF('V7'!C[-7],""Process Method Management compliances"")"
ActiveSheet.Range("O1") = "FBS Code"
ActiveSheet.Range("O2") = "CIV-ALI"
ActiveSheet.Range("O3") = "CIV-ARC-EXT"
ActiveSheet.Range("O4") = "CIV-ARC-STN"
ActiveSheet.Range("O5") = "CIV-ATG"
ActiveSheet.Range("O6") = "CIV-CSD"
ActiveSheet.Range("O7") = "CIV-ENA"
ActiveSheet.Range("O8") = "CIV-LSC"
ActiveSheet.Range("O9") = "CIV-MEP"
ActiveSheet.Range("O10") = "CIV-STN"
ActiveSheet.Range("O11") = "CIV-STR"
ActiveSheet.Range("O12") = "CIV-TUN"
ActiveSheet.Range("O13") = "INF-EXT"
ActiveSheet.Range("O14") = "INF-INT"
ActiveSheet.Range("O15") = "EMT"
ActiveSheet.Range("O16") = "HSE"
ActiveSheet.Range("O17") = "PMT"
ActiveSheet.Range("O18") = "QMS"
ActiveSheet.Range("O19") = "ROP-MNT"
ActiveSheet.Range("O20") = "SSA"
ActiveSheet.Range("O21") = "SYS-ENG"
ActiveSheet.Range("P1") = "No.Requirements"
ActiveSheet.Range("Q1") = "No.PMM's"
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$" & UBound(wbsArray()) + 2), , xlYes).Name = "table_TOTALS"
Range("table_TOTALS").Select
ActiveSheet.ListObjects(1).ShowTotals = True
ActiveSheet.ListObjects(1).ListColumns("Total Requirements").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("Requirements Complied").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("Requirements Compliance Blank").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("Total PMM's").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("PMM's Complied").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("PMM Compliance Blank").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$I$1:$M$5"), , xlYes).Name = _
"table_Volumes"
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$O$1:$Q$21"), , xlYes).Name = _
"table_FBS"
Columns("I").EntireColumn.AutoFit
Columns("O").EntireColumn.AutoFit
Range("H:H,N:N").ColumnWidth = 3
Dim locno As Integer
locno = 2
For Each wrd In wbsArray()
Dim loc As String
loc = wrd
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = loc
ActiveCell.FormulaR1C1 = "WBS"
ActiveSheet.Range("B1") = loc
Range("B1").Select
'ActiveWorkbook.Names.Add Name:="wbs" & loc, RefersToR1C1:="=" & ActiveSheet.Name & "!B1"
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With
'first table headings
ActiveSheet.Range("A3") = "Discipline"
ActiveSheet.Range("B3") = "FBS code"
ActiveSheet.Range("C3") = "No.Requirements"
ActiveSheet.Range("D3") = "Design Compliance Statement"
ActiveSheet.Range("E3") = "DS1 Ready"
ActiveSheet.Range("F3") = "DS1 Non Compliances"
ActiveSheet.Range("G3") = "DS1 Status"
ActiveSheet.Range("H3") = "DS2 Ready"
ActiveSheet.Range("I3") = "DS2 Non Compliances"
ActiveSheet.Range("J3") = "DS2 Status"
ActiveSheet.Range("K3") = "Total Agreed Validation"
ActiveSheet.Range("L3") = "Validation Compliance Statement"
ActiveSheet.Range("M3") = "Validation Status"
ActiveSheet.Range("N3") = "DCS"
ActiveSheet.Range("O3") = "VCS"
ActiveSheet.Range("P3") = "CS Blank"
ActiveSheet.Range("Q3") = "VS Blank"
'rows
ActiveSheet.Range("A4") = "Alignment"
ActiveSheet.Range("B4") = "CIV-ALI"
ActiveSheet.Range("A5") = "Architecture External"
ActiveSheet.Range("B5") = "CIV-ARC-EXT"
ActiveSheet.Range("A6") = "Architecture Station"
ActiveSheet.Range("B6") = "CIV-ARC-STN"
ActiveSheet.Range("A7") = "At Grade"
ActiveSheet.Range("B7") = "CIV-ATG"
ActiveSheet.Range("A8") = "Combined Services"
ActiveSheet.Range("B8") = "CIV-CSD"
ActiveSheet.Range("A9") = "Geotechnical"
ActiveSheet.Range("B9") = "CIV-ENA"
ActiveSheet.Range("A10") = "Landscaping"
ActiveSheet.Range("B10") = "CIV-LSC"
ActiveSheet.Range("A11") = "MEP"
ActiveSheet.Range("B11") = "CIV-MEP"
ActiveSheet.Range("A12") = "Station"
ActiveSheet.Range("B12") = "CIV-STN"
ActiveSheet.Range("A13") = "Structure"
ActiveSheet.Range("B13") = "CIV-STR"
ActiveSheet.Range("A14") = "Tunnel"
ActiveSheet.Range("B14") = "CIV-TUN"
ActiveSheet.Range("A15") = "External Interface"
ActiveSheet.Range("B15") = "INF-EXT"
ActiveSheet.Range("A16") = "Internal Interface"
ActiveSheet.Range("B16") = "INF-INT"
ActiveSheet.Range("A17") = "Engineering Management"
ActiveSheet.Range("B17") = "EMT"
ActiveSheet.Range("A18") = "Fire Life Safety"
ActiveSheet.Range("B18") = "HSE"
ActiveSheet.Range("A19") = "Project Management"
ActiveSheet.Range("B19") = "PMT"
ActiveSheet.Range("A20") = "Quality Management"
ActiveSheet.Range("B20") = "QMS"
ActiveSheet.Range("A21") = "O&M Management"
ActiveSheet.Range("B21") = "ROP-MNT"
ActiveSheet.Range("A22") = "Systems Assurance"
ActiveSheet.Range("B22") = "SSA"
ActiveSheet.Range("A23") = "Systems Engineering"
ActiveSheet.Range("B23") = "SYS-ENG"
'make table
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$3:$Q$23"), , xlYes).Name = _
"table_R" & loc
Range("Table_R" & loc & "[#All]").Select
ActiveSheet.ListObjects("Table_R" & loc).TableStyle = "TableStyleMedium7"
ActiveSheet.ListObjects(1).ShowTotals = True
ActiveSheet.ListObjects(1).ListColumns("No.Requirements").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("Total Agreed Validation").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("DCS").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("VCS").TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects(1).ListColumns("CS Blank").TotalsCalculation = xlTotalsCalculationSum
'add formatting
'Range("table_RALL[[Design Compliance Statement]:[Validation Status]]").Select
Range("D4:J23").Select
Selection.Style = "Percent"
Selection.FormatConditions.AddColorScale ColorScaleType:=2
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValuePercent
Selection.FormatConditions(1).ColorScaleCriteria(1).Value = 0
Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor.ThemeColor = xlThemeColorAccent2
Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor.TintAndShade = 0.6
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercent
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 100
Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor.ThemeColor = xlThemeColorAccent3
Range("L4:M23").Select
Selection.Style = "Percent"
Selection.FormatConditions.AddColorScale ColorScaleType:=2
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValuePercent
Selection.FormatConditions(1).ColorScaleCriteria(1).Value = 0
Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor.ThemeColor = xlThemeColorAccent2
Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor.TintAndShade = 0.6
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercent
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 100
Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor.ThemeColor = xlThemeColorAccent3
Columns("A:M").EntireColumn.AutoFit
Range("A3:M3").WrapText = True
Range("3:3").RowHeight = 30
Range("A:A").ColumnWidth = 24
Range("C:C").ColumnWidth = 16
Range("D:D").ColumnWidth = 17
Range("E:E,G:G,H:H,J:J").ColumnWidth = 10
Range("B:B,F:F,I:I,K:K").ColumnWidth = 12
Range("L:L").ColumnWidth = 20
Range("M:M").ColumnWidth = 16
Range("A3:B3").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Range("C3:M3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'second table
Range("A2:Q24").Select
Selection.Copy
Range("A25").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("C26") = "No.PMM's"
ActiveSheet.ListObjects(2).TableStyle = "TableStyleMedium6"
ActiveSheet.ListObjects(2).DisplayName = "TableP_" & loc
ActiveSheet.ListObjects(2).ShowTotals = True
Range("26:26").RowHeight = 30
' set up printing
With ActiveSheet.PageSetup
.PrintArea = ActiveSheet.Range("A1:M47").Address
.Orientation = xlLandscape
.FitToPagesWide = 1
.CenterHeader = "Requirements Status Summary"
.CenterFooter = "&A"
.RightFooter = "&D"
.PaperSize = xlPaperA3
End With
Range("B2").Select
Call populateTable("Requirement", 1, "No.Requirements")
Call populateTable("Process Method Management", 2, "No.PMM's")
'copy data into charts sheet
Worksheets("CHARTS").Range("A" & locno) = loc
Worksheets("CHARTS").Range("B" & locno) = ActiveSheet.ListObjects(1).ListColumns("No.Requirements").Total.Value
Worksheets("CHARTS").Range("E" & locno) = ActiveSheet.ListObjects(2).ListColumns("No.PMM's").Total.Value
Worksheets("CHARTS").Range("D" & locno) = ActiveSheet.ListObjects(1).ListColumns("CS Blank").Total.Value
Worksheets("CHARTS").Range("G" & locno) = ActiveSheet.ListObjects(2).ListColumns("CS Blank").Total.Value
Worksheets("CHARTS").Range("C" & locno) = ActiveSheet.ListObjects(1).ListColumns("DCS").Total.Value
Worksheets("CHARTS").Range("F" & locno) = ActiveSheet.ListObjects(2).ListColumns("DCS").Total.Value
Sheets("CHARTS").Select
Range("G39").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C[-5],R[-2]C[-2])"
Range("B38").Select
ActiveCell.FormulaR1C1 = _
"=table_TOTALS[[#Totals],[Total Requirements]]/R[1]C[5]"
Range("C38").Select
ActiveCell.FormulaR1C1 = _
"=table_TOTALS[[#Totals],[Requirements Complied]]/R[1]C[4]"
Range("D38").Select
ActiveCell.FormulaR1C1 = _
"=table_TOTALS[[#Totals],[Requirements Compliance Blank]]/R[1]C[3]"
Range("E38").Select
ActiveCell.FormulaR1C1 = "=table_TOTALS[[#Totals],[Total PMM''s]]/R[1]C[2]"
Range("F38").Select
ActiveCell.FormulaR1C1 = "=table_TOTALS[[#Totals],[PMM''s Complied]]/R[1]C[1]"
Range("G38").Select
Calculate
ActiveCell.FormulaR1C1 = _
"=table_TOTALS[[#Totals],[PMM Compliance Blank]]/R[1]C"
Range("G39").Select
Range("B38:G38").Select
Selection.NumberFormat = "0.00%"
locno = locno + 1
Next wrd
Sheets("CHARTS").Select
Range("P2:P21") = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
Range("Q2:Q21") = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
' Macro1 Macro
'
'
'add GRAPHS sheet
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = "GRAPHS"
Cells.Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'
'
' Macro2 Macro
'
'
Sheets("CHARTS").Select
Range("table_Volumes[#All]").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("CHARTS!$I$1:$M$5")
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "REQUIREMENTS BY ER'S VOLUMES"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"REQUIREMENTS BY ER'S VOLUMES"
With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
ActiveChart.PlotArea.Select
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 203
ActiveChart.SetElement (msoElementDataLabelCenter)
ActiveChart.FullSeriesCollection(3).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.FullSeriesCollection(3).DataLabels.Select
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
Selection.Orientation = xlDownward
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsObject, Name:="GRAPHS"
'
' Macro3 Macro
'
'
Sheets("CHARTS").Select
Sheets("CHARTS").Name = "CHARTS"
Sheets("CHARTS").Select
Range("table_FBS[#All]").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("CHARTS!$O$1:$Q$21")
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 203
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "REQUIREMENT'S BY WBS CODE"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"REQUIREMENT'S BY WBS CODE"
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).Font
End With
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementDataLabelCenter)
ActiveChart.FullSeriesCollection(2).DataLabels.Select
ActiveChart.PlotArea.Select
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(2).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(1).DataLabels.Select
ActiveChart.FullSeriesCollection(2).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.BaselineOffset = 0.02
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.BaselineOffset = 0.02
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsObject, Name:="GRAPHS"
'
' Macro4 Macro
'
'
Sheets("CHARTS").Select
Range("table_TOTALS[[#Headers],[#Data]]").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("CHARTS!$A$1:$G$37")
ActiveChart.FullSeriesCollection(2).IsFiltered = True
ActiveChart.FullSeriesCollection(3).IsFiltered = True
ActiveChart.FullSeriesCollection(5).IsFiltered = True
ActiveChart.FullSeriesCollection(6).IsFiltered = True
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "REQUIREMENT'S BY FBS CODE"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"REQUIREMENT'S BY FBS CODE"
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 25).Font
End With
ActiveChart.ChartArea.Select
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 203
ActiveChart.SetElement (msoElementDataLabelCenter)
ActiveChart.FullSeriesCollection(4).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Orientation = xlDownward
Selection.Format.TextFrame2.Orientation = msoTextOrientationDownward
ActiveChart.PlotArea.Select
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(4).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.BaselineOffset = 0.01
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.BaselineOffset = 0.01
ActiveChart.PlotArea.Select
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsObject, Name:="GRAPHS"
ActiveWindow.SmallScroll Down:=9
'
' Macro5 Macro
'
'
Range("B55").Select
Sheets("GRAPHS").Select
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(1).Values = "=CHARTS!$B$38,CHARTS!$E$38"
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "Requirements Summary"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Requirements Summary"
With Selection.Format.TextFrame2.TextRange.Characters(1, 20).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 12).Font
End With
With Selection.Format.TextFrame2.TextRange.Characters(13, 8).Font
End With
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementDataLabelBestFit)
Range("K61").Select
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(1).Values = _
"=CHARTS!$C$38,CHARTS!$D$38,CHARTS!$F$38,CHARTS!$G$38"
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = "Compliance Statement Summary"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"Compliance Statement Summary"
With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementDataLabelBestFit)
Sheets("GRAPHS").Select
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 5").IncrementLeft -488.25
ActiveSheet.Shapes("Chart 5").IncrementTop 3.75
ActiveSheet.Shapes("Chart 5").ScaleHeight 1.4600696267, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 5").ScaleWidth 1.2291666667, msoFalse, _
msoScaleFromTopLeft
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 4").ScaleHeight 1.4704862934, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 4").IncrementLeft 4.5
ActiveSheet.Shapes("Chart 4").IncrementTop 1.5
ActiveSheet.Shapes("Chart 4").ScaleWidth 1.1229166667, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveSheet.Shapes("Chart 3").IncrementLeft -509.25
ActiveSheet.Shapes("Chart 3").IncrementTop -167.25
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveSheet.Shapes("Chart 3").ScaleWidth 1.7520833333, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveSheet.Shapes("Chart 3").ScaleHeight 1.8454862934, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveSheet.Shapes("Chart 3").ScaleWidth 1.0535076041, msoFalse, _
msoScaleFromBottomRight
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 2").IncrementLeft 211.5
ActiveSheet.Shapes("Chart 2").IncrementTop -160.5
ActiveSheet.Shapes("Chart 2").ScaleWidth 1.7125, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 2").ScaleHeight 1.6336807378, msoFalse, _
msoScaleFromTopLeft
ActiveChart.ChartTitle.Select
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.PlotArea.Select
Selection.Left = 39.089
Selection.Top = 60.85
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartTitle.Select
ActiveChart.PlotArea.Select
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.PlotArea.Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").IncrementLeft -67.5
ActiveSheet.Shapes("Chart 1").IncrementTop 214.5
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.6875, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.1703703704, msoFalse, _
msoScaleFromBottomRight
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.3038196267, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.Shapes("Chart 1").IncrementLeft -19.5
ActiveSheet.Shapes("Chart 1").IncrementTop 46.5
End Sub
Sub populateTable(category As String, tableID As Integer, colHeading As String)
Dim tblTarget As ListObject
Dim tblSource As ListObject
Dim tRows As Integer
Dim sRows As Integer
Dim discipline As String
Dim wbs As String
Dim tRw As Integer
Dim sRw As Integer
'count variables
Dim cRequ As Integer
Dim cDCbl As Integer
Dim cDS1r As Integer
Dim cDS1n As Integer
Dim cDS1s As Integer
Dim cDS2r As Integer
Dim cDS2n As Integer
Dim cDS2s As Integer
Dim cVdag As Integer
Dim cVdcs As Integer
Dim cVdst As Integer
Set tblTarget = ActiveSheet.ListObjects(tableID)
tRows = tblTarget.DataBodyRange.Rows.Count
wbs = Range("B1").Value
'wbs = "xxx.xxx"
'loop through all rows in target table
For tRw = 1 To tRows
'reset counters
cRequ = 0
cDCbl = 0
cDCSt = 0
cDS1r = 0
cDS1n = 0
cDS1s = 0
cDS2r = 0
cDS2n = 0
cDS2s = 0
cVdbl = 0
cVdag = 0
cVdcs = 0
cVdst = 0
'get discipline name
discipline = tblTarget.ListColumns("FBS code").DataBodyRange.Rows(tRw)
'loop through all source tables
Dim v As Integer
For v = 2 To 5 'change here
Set tblSource = Worksheets(v).ListObjects(1)
sRows = tblSource.DataBodyRange.Rows.Count
'loop through individual source table
For sRw = 1 To sRows
'baseslab submission
'If InStr(tblSource.ListColumns("Contractor Comment").DataBodyRange.Rows(sRw), "BASESLAB") Then
'check if Atkins Internal Apportionment
'If tblSource.ListColumns("Contractor Internal Apportionment").DataBodyRange.Rows(sRw) = "ATKINS" Then
'check discipline matches & requirement/process variable
Dim cpFBS As String
cpFBS = tblSource.ListColumns("FBS").DataBodyRange.Rows(sRw)
If InStr(cpFBS, discipline) _
And tblSource.ListColumns("Category").DataBodyRange.Rows(sRw) = category Then
'''''''And tblSource.ListColumns("QR Identification").DataBodyRange.Rows(sRw) = "Tracked Requirement"
'check wbs2 matches
Dim wbs2 As String
wbs2 = tblSource.ListColumns("WBS2").DataBodyRange.Rows(sRw)
'check for match on type of WBS
If InStr(wbs2, wbs) Or wbs = "YC.PR.AAA" Then
'increment requirement cat count
cRequ = cRequ + 1
'check Design Compliance Statement blank
If tblSource.ListColumns("Design Compliance Statement").DataBodyRange.Rows(sRw) = "" Then
cDCbl = cDCbl + 1
'else check DS1 & DS2
Else
cDCSt = cDCSt + 1
'DS1 ready
Dim ds1r As String
ds1r = tblSource.ListColumns("DS1 Verification Request for Location").DataBodyRange.Rows(sRw)
If InStr(ds1r, wbs) Then
cDS1r = cDS1r + 1
End If
'DS2 ready
Dim ds2r As String
ds2r = tblSource.ListColumns("DS2 Verification Request for Location").DataBodyRange.Rows(sRw)
If InStr(ds2r, wbs) Then
cDS2r = cDS2r + 1
End If
'Design non-compliance
'DS1 non-compliance
Dim ds1n As String
ds1n = tblSource.ListColumns("DS1 Non-Compliant for Location").DataBodyRange.Rows(sRw)
If InStr(ds1n, wbs) Then
cDS1n = cDS1n + 1
End If
'DS2 non-compliance
Dim ds2n As String
ds2n = tblSource.ListColumns("DS2 Non-Compliant for Location").DataBodyRange.Rows(sRw)
If InStr(ds2n, wbs) Then
cDS2n = cDS2n + 1
End If
'Design Status
'DS1 status
Dim ds1s As String
ds1s = tblSource.ListColumns("DS1 Status").DataBodyRange.Rows(sRw)
If InStr(ds1s, wbs) Then
cDS1s = cDS1s + 1
End If
'DS2 status
Dim ds2s As String
ds2s = tblSource.ListColumns("DS2 Status").DataBodyRange.Rows(sRw)
If InStr(ds2s, wbs) Then
cDS2s = cDS2s + 1
End If
'check Agreed Validation
If tblSource.ListColumns("Validation Required?").DataBodyRange.Rows(sRw) = "Validation Required" Then
cVdag = cVdag + 1
End If
'check Validation Compliance blank
If tblSource.ListColumns("Validation Compliance Statement").DataBodyRange.Rows(sRw) = "" Then
cVdbl = cVdbl + 1
Else
'Validation compliance statement
cVdcs = cVdcs + 1
'Validation Status
Dim dsvs As String
dsvs = tblSource.ListColumns("Validation Status").DataBodyRange.Rows(sRw)
If InStr(dsvs, wbs) Then
cVdst = cVdst + 1
End If
End If
End If
End If
End If
'End If
'End If
Next sRw
Next v
'write into sheets
'tblTarget.ListColumns(colHeading).DataBodyRange.Rows(tRw) = cRequ
'tblTarget.ListColumns("Total Agreed Validation").DataBodyRange.Rows(tRw) = cVdag
tblTarget.ListColumns("DCS").DataBodyRange.Rows(tRw) = cDCSt
tblTarget.ListColumns("VCS").DataBodyRange.Rows(tRw) = cVdcs
tblTarget.ListColumns("CS Blank").DataBodyRange.Rows(tRw) = cDCbl
tblTarget.ListColumns("VS Blank").DataBodyRange.Rows(tRw) = cVdbl
If cRequ > 0 Then
tblTarget.ListColumns(colHeading).DataBodyRange.Rows(tRw) = cRequ
tblTarget.ListColumns("Design Compliance Statement").DataBodyRange.Rows(tRw) = cDCSt / cRequ
tblTarget.ListColumns("DS1 Ready").DataBodyRange.Rows(tRw) = cDS1r / cRequ
tblTarget.ListColumns("DS1 Non Compliances").DataBodyRange.Rows(tRw) = cDS1n / cRequ
tblTarget.ListColumns("DS1 Status").DataBodyRange.Rows(tRw) = cDS1s / cRequ
tblTarget.ListColumns("DS2 Ready").DataBodyRange.Rows(tRw) = cDS2r / cRequ
tblTarget.ListColumns("DS2 Non Compliances").DataBodyRange.Rows(tRw) = cDS2n / cRequ
tblTarget.ListColumns("DS2 Status").DataBodyRange.Rows(tRw) = cDS2s / cRequ
End If
If cVdag > 0 Then
tblTarget.ListColumns("Total Agreed Validation").DataBodyRange.Rows(tRw) = cVdag
tblTarget.ListColumns("Validation Compliance Statement").DataBodyRange.Rows(tRw) = cVdcs / cVdag
tblTarget.ListColumns("Validation Status").DataBodyRange.Rows(tRw) = cVdst / cVdag
End If
Next tRw
End Sub
