When pressing f5 function macro not running completely

zakaa

New Member
Joined
Jan 11, 2015
Messages
42
Sub DBtableFormat()
'
' DBtableFormat Macro
' Converts db exports to tables
'

'
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
'convert source data to table
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"

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

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 = 1 To 4

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

'
' macro1 Macro
'


'

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])"


End Sub
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
where does it fail, none of us have your worksheet


IS THIS THE SAME MACRO THAT WAS POSTED TWICE ALREADY ??.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,630
Messages
6,120,634
Members
448,973
Latest member
ChristineC

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top