Need to add the macro codes in one module these all codes in different module i need to make as one module

zakaa

New Member
Joined
Jan 11, 2015
Messages
42
Code:
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
    
End Sub
Sub newDataSheets()
'
' 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
                
        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
End Sub
  ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P3").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P4").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P5").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P6").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P7").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P8").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P9").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P10").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P11").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P12").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P13").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P14").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P15").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P16").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P17").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P18").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P19").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("P20").Select
Sub Macro1()
'
' Macro1 Macro
'
'
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q3").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q4").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q5").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q6").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q7").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q8").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q9").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q10").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q11").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q12").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q13").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q14").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q15").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q16").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q17").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q18").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q19").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q20").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q21").Select
    ActiveCell.FormulaR1C1 = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
    Range("Q22").Select
End Sub
 
Last edited by a moderator:

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
You can copy and paste all the codes into one module.
Then with the old modules, right click and select remove, you will be asked if you want to export the module, and select no.

Just looking at some of your code. Possibly using the below code would save a few lines.
Code:
    Range("P3:P20") = "=SUM(YC.PR.AAA:YW.BB.MUA!R[2]C[-13])"
    Range("Q3:Q20") = "=SUM(YC.PR.AAA:YW.BB.MUA!R[25]C[-14])"
 
Last edited:
Upvote 0
yes u r right brother I want the entire codes should be in one module I will send u the file And the code which u given its showing me error in out put #NAME? like dis help me
 
Upvote 0
And also i want to be get complete codes in one module from the starting till ending how can i do that will you please help me dave
 
Upvote 0
Dave already answered that - just copy and paste the code into the same module, with each procedure below the previous ones.
 
Upvote 0

Forum statistics

Threads
1,215,197
Messages
6,123,581
Members
449,108
Latest member
rache47

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