Trouble setting a print area..

4

450nick

Well-known Member
Joined
May 11, 2009
Messages
507
Hi all, I'm trying to set the print area using VBA and I'm getting an object error.. any idea why?

Code: 
CTRp.Sheets("MDR").PageSetup.PrintArea = CTRp.Sheets("MDR").Range("A1:N" & CTRp.Sheets("MDR").Cells(10000, 2).End(xlUp).Row)
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
Presuming CTRp has a worksheet called "MDR" can you show how you set CTRp?
 
Upvote 0
Sure, the workbook definitely has a worksheet called MDR and CTRp is loaded like this:

Code: 
Dim CTRp As Workbook
Set CTRp = Workbooks.Open(Filename:=Wb.Range("CTRTemplateLocation"), ReadOnly:=True)
 
Upvote 0
Struggling to see anything wrong with what you have provided. The workbook variable must be correct or it would fail earlier. Maybe provide all the code and can take a look at that.
 
Upvote 0
Thanks Steve, so here is the triggering macro (running from a button on a userform), the two lines of code that are causing error are in this macro (currently deactivated):

Code: 
Private Sub CreateCTRs_Click()Dim Ploc As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Me.MultiPage1.SelectedItem.Name = "Page1" Then Ploc = ThisWorkbook.Sheets("Settings").Range("ScheduleTemplateLocation"): NB = True
If Me.MultiPage1.SelectedItem.Name = "Page2" Then Ploc = Me.EPrjLoc.Value: NB = False
If Me.MultiPage1.SelectedItem.Name = "Page3" Then GoTo skip
Call RunProject.CreateCTRs(Me.CTRNo.Value, Me.ProjectBox.Value, Me.ClientBox.Value, Me.TechL.Value, Curr_S, Region_S, SL_Level, Ploc, NB)
Application.Calculation = xlCalculationAutomatic
'CTRp.Sheets("MDR").PageSetup.PrintArea = CTRp.Sheets("MDR").Range("A1:N" & CTRp.Sheets("MDR").Cells(10000, 2).End(xlUp).Row)
'CTRp.Sheets("Inputs").PageSetup.PrintArea = CTRp.Sheets("Inputs").Range("A1:J" & CTRp.Sheets("Inputs").Cells(10000, 2).End(xlUp).Row)


Application.ScreenUpdating = True
Unload Me
Application.DisplayAlerts = False
ThisWorkbook.Close
Application.DisplayAlerts = True
skip:
End Sub

Then here is the working macro (it pulls info from MS Project and builds up an Excel workbook)

Code: 
Sub CreateCTRs(CTRNo, Project, Customer, TechL, Curr, Region, SL_L, Ploc As String, NB)Dim t As Task
Dim Proj As MSProject.Application
Dim Wb As Worksheet
Dim Prj As Project
Dim CTRp As Workbook
Set Wb = ThisWorkbook.Sheets("Settings")
        If Curr = "" Then Curr = "USD"
        If Curr = "GBP" Then NumberF = "_-[$£-en-GB]* #,##0_-;-[$£-en-GB]* #,##0_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
        If Curr = "USD" Then NumberF = "_-[$$-en-US]* #,##0_ ;_-[$$-en-US]* -#,##0 ;_-[$$-en-US]* ""-""??_ ;_-@_ "
        If Curr = "EUR" Then NumberF = "_-[$€-x-euro2] * #,##0_-;-[$€-x-euro2] * #,##0_-;_-[$€-x-euro2] * ""-""??_-;_-@_-"
        If Curr = "NOK" Then NumberF = "_ [$kr-smj-NO] * #,##0_ ;_ [$kr-smj-NO] * -#,##0_ ;_ [$kr-smj-NO] * ""-""??_ ;_ @_ "
        If Curr = "BRL" Then NumberF = "_-[$R$-pt-BR] * #,##0_-;-[$R$-pt-BR] * #,##0.00_-;_-[$R$-pt-BR] * ""-""??_-;_-@_-"
        If Curr = "CAD" Then NumberF = "_-[$$-en-CA]* #,##0_-;-[$$-en-CA]* #,##0_-;_-[$$-en-CA]* ""-""??_-;_-@_-"
        If Curr = "AUD" Then NumberF = "_-[$$-en-AU]* #,##0_-;-[$$-en-AU]* #,##0_-;_-[$$-en-AU]* ""-""??_-;_-@_-"
        


If NB = False Then
    Set Proj = CreateObject("MSProject.Application")
    Proj.FileOpen Name:=Ploc, ReadOnly:=False, openPool:=pjPoolReadOnly
End If
Set Prj = GetObject(Ploc)
'##########################################################################
'Count CTRs
ReDim CTRs(Prj.Tasks.Count)
r1 = 0
For Each t In Prj.Tasks
    If t.WBS = "1" Then
            chs = 1: chx = 0: Rs = 0: rn = t.Notes
            ReDim PRi(6)
            For ch = 1 To Len(rn)
                If Mid(rn, ch, 1) = "|" Then
                    PRi(chx) = Mid(rn, chs, (ch - chs))
                    chs = ch + 1: chx = chx + 1: Rs = Rs + 1
                End If
            Next ch
            If Rs = 0 Then PRi(chx) = rn
            If Rs > 0 Then PRi(chx) = Mid(rn, chs, Len(rn) - chs + 1)
            Customer = PRi(0)
            Project = PRi(1)
            TechL = PRi(2)
            CTRNo = PRi(3)
            Curr = PRi(4)
            Region = PRi(5)
            SL = PRi(6)
    End If
    
    If Not t Is Nothing Then
    If t.Active = True Then
        If Not t.Text2 = "" Then
            If Not t.Text2 = "CTR #:" Then
                For r0 = LBound(CTRs) To UBound(CTRs)
                    If CTRs(r0) = t.Text2 Then GoTo skipr0
                Next r0
                CTRs(r1) = t.Text2
                r1 = r1 + 1
skipr0:
            End If
        End If


    End If
    End If
skipnext:
Next t


CTRCount = 0
For i = LBound(CTRs) To UBound(CTRs)
    If Not CTRs(i) = "" Then CTRCount = CTRCount + 1
Next i
ReDim Preserve CTRs(CTRCount - 1)


'##########################################################################
'Build CTR Array
ReDim CTRArray(CTRCount - 1, Prj.Tasks.Count, 9)
For r2 = LBound(CTRs) To UBound(CTRs)
    r3 = 0
    For Each t In Prj.Tasks
        If t.Text2 = CTRs(r2) And t.Active = True Then
            CTRArray(r2, r3, 0) = t.Name
            CTRArray(r2, r3, 1) = t.Text1
            CTRArray(r2, r3, 2) = t.ResourceNames
            CTRArray(r2, r3, 3) = t.Work
            CTRArray(r2, r3, 4) = t.Duration
            CTRArray(r2, r3, 5) = t.Start
            CTRArray(r2, r3, 6) = t.Finish
            CTRArray(r2, r3, 7) = t.Text4
        r3 = r3 + 1
        End If
    Next t
Next r2
'##########################################################################




'Set up CTR Tabs
Set CTRp = Workbooks.Open(Filename:=Wb.Range("CTRTemplateLocation"), ReadOnly:=True)
CTRp.Activate
Z = 1
For i = LBound(CTRs) To UBound(CTRs)
    Set ws = CTRp.Sheets("CTR1")
    ws.Copy After:=CTRp.Sheets(CTRp.Sheets("CTR1").Index + (Z - 1))
    Set wsNew = CTRp.Sheets(CTRp.Sheets("CTR1").Index + Z)
    wsNew.Name = "CTR" & CTRs(i)
    Z = Z + 1
Next i
Application.DisplayAlerts = False
CTRp.Sheets("CTR1").Delete
Application.DisplayAlerts = True
MDRRow = 11
MD = 1
INPRow = 11
IP = 1


'Populate CTR Template
'Create Arrays
'#########################################################################
For i = LBound(CTRs) To UBound(CTRs)
    'Populate Scope of Work Array
    ReDim SoW(UBound(CTRArray, 2), 4)
    k = 0
    For j = LBound(CTRArray, 2) To UBound(CTRArray, 2)
        If Not CTRArray(i, j, 0) = "" Then
            SoW(k, 0) = CTRArray(i, j, 0)
            SoW(k, 1) = CTRArray(i, j, 4)
            SoW(k, 2) = CTRArray(i, j, 5)
            SoW(k, 3) = CTRArray(i, j, 6)
            SoW(k, 4) = CTRArray(i, j, 2)
            k = k + 1
        End If
    Next j
    
    'Populate Deliverables Array
    ReDim Del(UBound(CTRArray, 2), 4)
    l = 0
    For j = LBound(CTRArray, 2) To UBound(CTRArray, 2)
        If Not CTRArray(i, j, 1) = "" Then
            Del(l, 0) = CTRArray(i, j, 1)
            Del(l, 1) = CTRArray(i, j, 4)
            Del(l, 2) = CTRArray(i, j, 5)
            Del(l, 3) = CTRArray(i, j, 6)
            Del(l, 4) = CTRArray(i, j, 2)
            l = l + 1
        End If
    Next j
    
    'Populate Inputs Array
        ReDim InpArray(50, 5)
        n = 0
    For j = LBound(CTRArray, 2) To UBound(CTRArray, 2)
        If Not CTRArray(i, j, 7) = "" Then
        chs = 1: chx = 0: Rs = 0: rn = CTRArray(i, j, 7)
        ReDim Inp(19, 3)


        If Len(rn) > 0 Then
            For ch = 1 To Len(rn)
                If Mid(rn, ch, 1) = "," Then
                    Inp(chx, 0) = Mid(rn, chs, (ch - chs))
                    chs = ch + 1: chx = chx + 1: Rs = Rs + 1
                End If
            Next ch
            If Rs = 0 Then Inp(chx, 0) = rn
            If Rs > 0 Then Inp(chx, 0) = Mid(rn, chs, Len(rn) - chs + 1)
            
            'Collect into main array
            For R = LBound(Inp, 1) To UBound(Inp, 1)
                flg = 0
                If Inp(R, 0) = "0" Or Inp(R, 0) = "" Then
                Else
                    For q = LBound(InpArray, 1) To UBound(InpArray, 1)
                        If Not InpArray(q, 0) = "" And InpArray(q, 0) = Inp(R, 0) Then flg = 1: Exit For
                    Next q
                    If flg = 1 Then
                        'do nothing for dupes
                    End If
                    If flg = 0 Then
                        For s = LBound(InpArray, 1) To UBound(InpArray, 1)
                            If InpArray(s, 0) = "" Then InpArray(s, 0) = Inp(R, 0): InpArray(s, 1) = CTRArray(i, j, 5): n = n + 1: Exit For
                        Next s
                    End If
                End If
            Next R
        End If
        End If
    Next j
    
    'Resources Array
'########################################################################################################
'Extract Resources
        ReDim ResArray(50, 5)
        M = 0
        P = 0
    For j = LBound(CTRArray, 2) To UBound(CTRArray, 2)
        chs = 1: chx = 0: Rs = 0: rn = CTRArray(i, j, 2)
        ReDim Res(19, 3)
        
        If Len(rn) > 0 Then
            For ch = 1 To Len(rn)
                If Mid(rn, ch, 1) = "," Then
                    Res(chx, 0) = Mid(rn, chs, (ch - chs))
                    chs = ch + 1: chx = chx + 1: Rs = Rs + 1
                End If
            Next ch
            If Rs = 0 Then Res(chx, 0) = rn
            If Rs > 0 Then Res(chx, 0) = Mid(rn, chs, Len(rn) - chs + 1)
            
        'Extract % Util
            Tutil = 0
            For R = LBound(Res, 1) To Rs
                If Right(Res(R, 0), 1) = "]" Then
                    If Right(Res(R, 0), 2) = "%]" Then
                        If Mid(Res(R, 0), Len(Res(R, 0)) - 4, 1) = "[" Then
                            Res(R, 2) = Mid(Res(R, 0), Len(Res(R, 0)) - 3, 2)
                            Res(R, 0) = Left(Res(R, 0), Len(Res(R, 0)) - 5)
                        ElseIf Mid(Res(R, 0), Len(Res(R, 0)) - 3, 1) = "[" Then
                            Res(R, 2) = Mid(Res(R, 0), Len(Res(R, 0)) - 2, 1)
                            Res(R, 0) = Left(Res(R, 0), Len(Res(R, 0)) - 4)
                        ElseIf Mid(Res(R, 0), Len(Res(R, 0)) - 5, 1) = "[" Then
                            Res(R, 2) = Mid(Res(R, 0), Len(Res(R, 0)) - 4, 1)
                            Res(R, 0) = Left(Res(R, 0), Len(Res(R, 0)) - 6)
                        ElseIf Mid(Res(R, 0), Len(Res(R, 0)) - 6, 1) = "[" Then
                            Res(R, 2) = Mid(Res(R, 0), Len(Res(R, 0)) - 5, 1)
                            Res(R, 0) = Left(Res(R, 0), Len(Res(R, 0)) - 7)
                        End If
                        Tutil = Tutil + Res(R, 2)
                    Else
                        If Mid(Res(R, 0), Len(Res(R, 0)) - 3, 1) = "[" Then
                            Res(R, 3) = Mid(Res(R, 0), Len(Res(R, 0)) - 2, 2)
                            Res(R, 1) = "Material"
                            Res(R, 0) = Left(Res(R, 0), Len(Res(R, 0)) - 4)
                        ElseIf Mid(Res(R, 0), Len(Res(R, 0)) - 2, 1) = "[" Then
                            Res(R, 3) = Mid(Res(R, 0), Len(Res(R, 0)) - 1, 1)
                            Res(R, 1) = "Material"
                            Res(R, 0) = Left(Res(R, 0), Len(Res(R, 0)) - 3)
                        ElseIf Mid(Res(R, 0), Len(Res(R, 0)) - 4, 1) = "[" Then
                            Res(R, 3) = Mid(Res(R, 0), Len(Res(R, 0)) - 3, 1)
                            Res(R, 1) = "Material"
                            Res(R, 0) = Left(Res(R, 0), Len(Res(R, 0)) - 5)
                        ElseIf Mid(Res(R, 0), Len(Res(R, 0)) - 5, 1) = "[" Then
                            Res(R, 3) = Mid(Res(R, 0), Len(Res(R, 0)) - 4, 1)
                            Res(R, 1) = "Material"
                            Res(R, 0) = Left(Res(R, 0), Len(Res(R, 0)) - 6)
                        End If
                    End If
                Else
                    Res(R, 2) = 100
                    Tutil = Tutil + Res(R, 2)
                End If
            Next R
        
        'Extract Location
            For R = LBound(Res, 1) To Rs
                If Not Res(R, 1) = "Material" Then
                    LocS = 0
                    For ch = 1 To Len(Res(R, 0))
                        If Mid(Res(R, 0), ch, 1) = "(" Then LocS = ch
                        If Mid(Res(R, 0), ch, 1) = ")" Then locF = ch
                    Next ch
                    If LocS > 0 Then
                        Res(R, 1) = Mid(Res(R, 0), LocS + 1, (locF - LocS) - 1)
                        Res(R, 0) = Left(Res(R, 0), LocS - 2)
                    End If
                End If
            Next R
            End If
            
            'Work out hours allocation
            For R = LBound(Res, 1) To UBound(Res, 1)
                If Not Res(R, 1) = "Material" Then
                    If Res(R, 0) = 0 Or Res(R, 0) = "" Then
                    
                    Else
                        Res(R, 3) = (CTRArray(i, j, 3) / Tutil) * Res(R, 2)
                    End If
                End If
            Next R


            'Collect into main array
            For R = LBound(Res, 1) To UBound(Res, 1)
                flg = 0
                If Res(R, 0) = "0" Or Res(R, 0) = "" Then
                Else
                    For q = LBound(ResArray, 1) To UBound(ResArray, 1)
                        If Not ResArray(q, 0) = "" And ResArray(q, 0) = Res(R, 0) Then flg = 1: Exit For
                    Next q
                    If flg = 1 Then ResArray(q, 1) = ResArray(q, 1) + Res(R, 3)
                    If flg = 0 Then
                        For s = LBound(ResArray, 1) To UBound(ResArray, 1)
                            If ResArray(s, 0) = "" Then
                                ResArray(s, 0) = Res(R, 0)
                                ResArray(s, 2) = Res(R, 1)
                                ResArray(s, 1) = Res(R, 3)
                                If Res(R, 1) = "Material" Then P = P + 1 Else M = M + 1
                                Exit For
                            End If
                        Next s
                    End If
                End If
            Next R
        
        Next j
        
'########################################################################################################


    For G = LBound(ResArray, 1) To UBound(ResArray, 1)
        If Not ResArray(G, 0) = "" Then
            For H = 1 To Prj.Resources.Count
                    'If Prj.Resources(H).Type = pjResourceTypeWork Then
                        If ResArray(G, 0) = Prj.Resources(H).Name Or ResArray(G, 0) & " (" & ResArray(G, 2) & ")" = Prj.Resources(H).Name Then
                            ResArray(G, 3) = Prj.Resources(H).Text1
                            ResArray(G, 4) = Mid(Prj.Resources(H).StandardRate, 2, Len(Prj.Resources(H).StandardRate) - 4)
                            ResArray(G, 5) = Prj.Resources(H).Group
                            Exit For
                        End If
                    'Else
                        
                    'End If
            Next H
        End If
    Next G
'Write to sheet
'#########################################################################
    'Titles
    CTRp.Sheets("CTR" & CTRs(i)).Cells(5, 3).Value = CTRNo
    CTRp.Sheets("CTR" & CTRs(i)).Cells(6, 3).Value = Customer
    CTRp.Sheets("CTR" & CTRs(i)).Cells(7, 3).Value = Project
    CTRp.Sheets("CTR" & CTRs(i)).Cells(6, 9).Value = TechL
    CTRp.Sheets("CTR" & CTRs(i)).Cells(7, 9).Value = Curr
    CTRp.Sheets("CTR" & CTRs(i)).Cells(5, 9).Value = Format(Date, "dd-mmm-yy")


    'Create Scope of Work
    CTRp.Sheets("CTR" & CTRs(i)).Rows("14:" & (14 + (k - 1) - 1)).EntireRow.Insert
    Z = 0
    For q = 14 To (14 + (k - 1))
        CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Merge
        CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Font.Bold = False
        CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":G" & q).HorizontalAlignment = xlLeft
        
        If Not q = (14 + (k - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).LineStyle = xlContinuous
        If Not q = (14 + (k - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        If Not q = (14 + (k - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).Weight = xlHairline


        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 2).Value = SoW(Z, 0)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 8).NumberFormat = "dd-mmm-yy"
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 9).NumberFormat = "dd-mmm-yy"
        Z = Z + 1
    Next q
    
    'Create Deliverables
    DelRow = 17 + k
    If l > 1 Then CTRp.Sheets("CTR" & CTRs(i)).Rows(DelRow & ":" & (DelRow + (l - 1) - 1)).EntireRow.Insert
    Z = 0
    For q = DelRow To (DelRow + (l - 1))
        CTRp.Sheets("CTR" & CTRs(i)).Range("D" & q & ":F" & q).Merge
        If Not q = (DelRow + (l - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).LineStyle = xlContinuous
        If Not q = (DelRow + (l - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        If Not q = (DelRow + (l - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).Weight = xlHairline
        CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Font.Bold = False
        CTRp.Sheets("CTR" & CTRs(i)).Range("D" & q & ":F" & q).HorizontalAlignment = xlLeft
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 4).Value = Del(Z, 0)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 8).Value = Del(Z, 2)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 9).Value = Del(Z, 3)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 2).Value = Z + 1
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 8).NumberFormat = "dd-mmm-yy"
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 9).NumberFormat = "dd-mmm-yy"
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 7).Value = "PDF"


        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 3).Value = "OSS-" & CTRNo & "-" & CTRs(i) & "-" & Format((Z + 1), "000")
        
        If l > 1 Then CTRp.Sheets("MDR").Rows(MDRRow & ":" & (MDRRow + (l - 1) - 1)).EntireRow.Insert
        CTRp.Sheets("MDR").Range("C" & MDRRow & ":D" & MDRRow).Merge
        CTRp.Sheets("MDR").Range("E" & MDRRow & ":G" & MDRRow).Merge
        CTRp.Sheets("MDR").Range("B" & MDRRow & ":M" & MDRRow).Borders(xlEdgeBottom).LineStyle = xlContinuous
        CTRp.Sheets("MDR").Range("B" & MDRRow & ":M" & MDRRow).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        CTRp.Sheets("MDR").Range("B" & MDRRow & ":M" & MDRRow).Borders(xlEdgeBottom).Weight = xlHairline
        CTRp.Sheets("MDR").Range("B" & MDRRow & ":M" & MDRRow).Font.Bold = False
        CTRp.Sheets("MDR").Range("E" & MDRRow & ":G" & MDRRow).HorizontalAlignment = xlLeft
        CTRp.Sheets("MDR").Range("B" & MDRRow & ":D" & MDRRow).HorizontalAlignment = xlCenter
        CTRp.Sheets("MDR").Range("H" & MDRRow & ":M" & MDRRow).HorizontalAlignment = xlCenter
        CTRp.Sheets("MDR").Cells(MDRRow, 3).Font.Size = 9
        CTRp.Sheets("MDR").Cells(MDRRow, 5).Value = Del(Z, 0)
        CTRp.Sheets("MDR").Cells(MDRRow, 8).Value = Del(Z, 2)
        CTRp.Sheets("MDR").Cells(MDRRow, 13).Value = Del(Z, 3)
        CTRp.Sheets("MDR").Cells(MDRRow, 2).Value = MD
        CTRp.Sheets("MDR").Range("H" & MDRRow & ":M" & MDRRow).NumberFormat = "dd-mmm-yy"
        CTRp.Sheets("MDR").Cells(MDRRow, 10).NumberFormat = "0"
        CTRp.Sheets("MDR").Cells(MDRRow, 3).Value = "OSS-" & CTRNo & "-" & CTRs(i) & "-" & Format((Z + 1), "000")
        CTRp.Sheets("MDR").Range("A" & MDRRow & ":M" & MDRRow).Orientation = 0
        CTRp.Sheets("MDR").Rows(MDRRow & ":" & (MDRRow + (l - 1) - 1)).AutoFit
        MD = MD + 1
        MDRRow = MDRRow + 1
        Z = Z + 1
    Next q


    'Create Inputs
    If l = 0 Then l = 1
    IPRow = 20 + k + l
    If n > 1 Then CTRp.Sheets("CTR" & CTRs(i)).Rows(IPRow & ":" & (IPRow + (n - 1) - 1)).EntireRow.Insert
    Z = 0
    For q = IPRow To (IPRow + (n - 1))
        CTRp.Sheets("CTR" & CTRs(i)).Range("D" & q & ":F" & q).Merge
        If Not q = (IPRow + (n - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).LineStyle = xlContinuous
        If Not q = (IPRow + (n - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        If Not q = (IPRow + (n - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).Weight = xlHairline
        CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Font.Bold = False
        CTRp.Sheets("CTR" & CTRs(i)).Range("D" & q & ":F" & q).HorizontalAlignment = xlLeft
        CTRp.Sheets("CTR" & CTRs(i)).Range("H" & q & ":I" & q).HorizontalAlignment = xlCenter
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 4).Value = InpArray(Z, 0)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 8).Value = InpArray(Z, 1)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 2).Value = Z + 1
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 8).NumberFormat = "dd-mmm-yy"
        
        If n > 1 Then CTRp.Sheets("Inputs").Rows(INPRow & ":" & (INPRow + (n - 1) - 1)).EntireRow.Insert
        CTRp.Sheets("Inputs").Range("C" & INPRow & ":D" & INPRow).Merge
        CTRp.Sheets("Inputs").Range("E" & INPRow & ":H" & INPRow).Merge
        CTRp.Sheets("Inputs").Range("B" & INPRow & ":I" & INPRow).Borders(xlEdgeBottom).LineStyle = xlContinuous
        CTRp.Sheets("Inputs").Range("B" & INPRow & ":I" & INPRow).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        CTRp.Sheets("Inputs").Range("B" & INPRow & ":I" & INPRow).Borders(xlEdgeBottom).Weight = xlHairline
        CTRp.Sheets("Inputs").Range("B" & INPRow & ":I" & INPRow).Font.Bold = False
        CTRp.Sheets("Inputs").Range("E" & INPRow & ":G" & INPRow).HorizontalAlignment = xlLeft
        CTRp.Sheets("Inputs").Range("B" & INPRow & ":D" & INPRow).HorizontalAlignment = xlCenter
        CTRp.Sheets("Inputs").Range("I" & INPRow & ":I" & INPRow).HorizontalAlignment = xlCenter
        CTRp.Sheets("Inputs").Cells(INPRow, 5).Value = InpArray(Z, 0)
        CTRp.Sheets("Inputs").Cells(INPRow, 9).Value = InpArray(Z, 1)
        CTRp.Sheets("Inputs").Cells(INPRow, 3).Value = CTRs(i)
        CTRp.Sheets("Inputs").Cells(INPRow, 2).Value = IP
        CTRp.Sheets("Inputs").Range("I" & INPRow & ":I" & INPRow).NumberFormat = "dd-mmm-yy"
        CTRp.Sheets("Inputs").Rows(INPRow & ":" & (INPRow + (n - 1) - 1)).AutoFit
        IP = IP + 1
        INPRow = INPRow + 1
        Z = Z + 1
    Next q
    
    'Create Resources
    If n = 0 Then n = 1
    Resrow = 23 + l + k + (n)
    If M > 1 Then CTRp.Sheets("CTR" & CTRs(i)).Rows(Resrow & ":" & (Resrow + (M - 1) - 1)).EntireRow.Insert
    Z = 0
    X = 0
    For q = Resrow To (Resrow + (M - 1))
skipbackres:
        If ResArray(Z, 2) = "Material" Then Z = Z + 1: GoTo skipbackres
        CTRp.Sheets("CTR" & CTRs(i)).Range("D" & q & ":F" & q).Merge
        CTRp.Sheets("CTR" & CTRs(i)).Range("D" & q & ":D" & q).HorizontalAlignment = xlLeft
        CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":C" & q).HorizontalAlignment = xlLeft
        If Not q = (Resrow + (M - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).LineStyle = xlContinuous
        If Not q = (Resrow + (M - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        If Not q = (Resrow + (M - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).Weight = xlHairline
        
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 4).Value = ResArray(Z, 0)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 7).Value = (ResArray(Z, 1) / 60)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 7).NumberFormat = "0"
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 5).Value = ResArray(Z, 3)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 8).Value = ResArray(Z, 4) ' * XC
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 3).Value = ResArray(Z, 5)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 2).Value = X + 1
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 2).HorizontalAlignment = xlCenter
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 3).HorizontalAlignment = xlCenter
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 8).NumberFormat = NumberF
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 9).FormulaR1C1 = "=RC[-2]*RC[-1]"
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 9).NumberFormat = NumberF
        CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Font.Bold = False
Z = Z + 1
X = X + 1
    Next q
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 1), 7).Formula = "=Sum(G" & Resrow & ": G" & (Resrow + (M - 1)) & ")"
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 1), 9).Formula = "=Sum(I" & Resrow & ": I" & (Resrow + (M - 1)) & ")"
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 1), 9).NumberFormat = NumberF
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 5), 9).NumberFormat = NumberF
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 5), 9).NumberFormat = NumberF
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 7), 9).NumberFormat = NumberF
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 9), 8).NumberFormat = NumberF
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 9), 8).Formula = "=I" & Resrow + M + 1 & "+I" & q + 7
    
    
    'Create Materials
    If M = 0 Then M = 1
    If P = 0 Then P = 1
    Matrow = 28 + l + k + n + M
    If P > 1 Then CTRp.Sheets("CTR" & CTRs(i)).Rows(Matrow & ":" & (Matrow + (P - 1) - 1)).EntireRow.Insert
    Z = 0
    X = 0
    For q = Matrow To (Matrow + (P - 1))
skipbackmat:
        If Not Z = UBound(ResArray, 1) Then If Not ResArray(Z, 2) = "Material" Then Z = Z + 1: GoTo skipbackmat
        CTRp.Sheets("CTR" & CTRs(i)).Range("C" & q & ":F" & q).Merge
        CTRp.Sheets("CTR" & CTRs(i)).Range("C" & q & ":F" & q).HorizontalAlignment = xlLeft
        If Not q = (Matrow + (P - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).LineStyle = xlContinuous
        If Not q = (Matrow + (P - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        If Not q = (Matrow + (P - 1)) Then CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Borders(xlEdgeBottom).Weight = xlHairline
        
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 3).Value = ResArray(Z, 0)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 7).Value = ResArray(Z, 1)
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 7).NumberFormat = "0"
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 8).Value = ResArray(Z, 4) ' * XC
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 2).Value = X + 1
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 2).HorizontalAlignment = xlCenter
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 8).NumberFormat = NumberF
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 9).FormulaR1C1 = "=RC[-2]*RC[-1]"
        CTRp.Sheets("CTR" & CTRs(i)).Cells(q, 9).NumberFormat = NumberF
        CTRp.Sheets("CTR" & CTRs(i)).Range("B" & q & ":I" & q).Font.Bold = False
        Z = Z + 1
        X = X + 1
    Next q
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 1), 7).Formula = "=Sum(G" & Matrow & ": G" & (Matrow + (P - 1)) & ")"
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 1), 9).Formula = "=Sum(I" & Matrow & ": I" & (Matrow + (P - 1)) & ")"
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 1), 9).NumberFormat = NumberF
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 5), 9).NumberFormat = NumberF
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 5), 9).NumberFormat = NumberF
    CTRp.Sheets("CTR" & CTRs(i)).Cells((q + 7), 9).NumberFormat = NumberF




'#########################################################################


Next i
'Build Summary


CTRp.Sheets("Summary").Activate
CTRp.Sheets("Summary").Cells(13, 9).NumberFormat = NumberF
CTRp.Sheets("Summary").Cells(15, 8).NumberFormat = NumberF
CTRp.Sheets("Summary").Cells(15, 9).NumberFormat = NumberF
CTRp.Sheets("Summary").Cells(17, 9).NumberFormat = NumberF




CTRp.Sheets("Summary").Cells(5, 4).Value = CTRNo
CTRp.Sheets("Summary").Cells(6, 4).Value = Customer
CTRp.Sheets("Summary").Cells(21, 4).Value = Customer
CTRp.Sheets("Summary").Cells(7, 4).Value = Project
CTRp.Sheets("Summary").Cells(8, 4).Value = Region


CTRp.Sheets("Summary").Cells(6, 9).Value = Application.UserName
CTRp.Sheets("Summary").Cells(5, 9).Value = Format(Date, "dd-mmm-yyyy")
CTRp.Sheets("Summary").Cells(7, 9).Value = Curr
CTRp.Sheets("Summary").Cells(8, 9).Value = SL


k = 0
l = 0
For i = LBound(CTRs) To UBound(CTRs)
    CTRp.Sheets("Summary").Rows((13 + k) & ":" & (13 + k)).EntireRow.Insert
    If Not i = UBound(CTRs) Then CTRp.Sheets("Summary").Range("B" & 13 + k & ":I" & 13 + k).Borders(xlEdgeBottom).LineStyle = xlContinuous
    If Not i = UBound(CTRs) Then CTRp.Sheets("Summary").Range("B" & 13 + k & ":I" & 13 + k).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
    If Not i = UBound(CTRs) Then CTRp.Sheets("Summary").Range("B" & 13 + k & ":I" & 13 + k).Borders(xlEdgeBottom).Weight = xlHairline
    CTRp.Sheets("Summary").Range("B" & 13 + k & ":I" & 13 + k).Font.Bold = False


    CTRp.Sheets("Summary").Range("C" & (13 + k) & ":E" & (13 + k)).Merge
    CTRp.Sheets("Summary").Range("F" & (13 + k) & ":G" & (13 + k)).Merge
    CTRp.Sheets("Summary").Cells(13 + k, 2).Value = "'" & CTRs(i)
    CTRp.Sheets("Summary").Cells(13 + k, 3).Value = "Enter Title"
    CTRp.Sheets("Summary").Cells(13 + k, 6).Formula = "=INDEX(INDIRECT(""'CTR""&B" & (13 + k) & "&""'!A1:I10000""),MATCH(""MATERIALS / EQUIPMENT OR OTHER SERVICES"",INDIRECT(""'CTR""&B" & (13 + k) & "&""'!B1:B10000""),0)-2,7)"
    CTRp.Sheets("Summary").Cells(13 + k, 8).Formula = "=INDEX(INDIRECT(""'CTR""&B" & (13 + k) & "&""'!A1:I10000""),MATCH(""MATERIALS / EQUIPMENT OR OTHER SERVICES"",INDIRECT(""'CTR""&B" & (13 + k) & "&""'!B1:B10000""),0)-2,9)"
    CTRp.Sheets("Summary").Cells(13 + k, 9).Formula = "=INDEX(INDIRECT(""'CTR""&B" & (13 + k) & "&""'!A1:I10000""),MATCH(""Total CTR Value: "",INDIRECT(""'CTR""&B" & (13 + k) & "&""'!G1:G10000""),0)-2,9)"
    CTRp.Sheets("Summary").Cells(13 + k, 6).NumberFormat = "0"
    CTRp.Sheets("Summary").Cells(13 + k, 9).NumberFormat = NumberF
    CTRp.Sheets("Summary").Cells(13 + k, 8).NumberFormat = NumberF
    k = k + 1
Next i
CTRp.Sheets("Summary").Rows(13 + k).EntireRow.Delete


CTRp.Sheets("Summary").Cells(14 + k, 6).Formula = "=Sum(F13:F" & (12 + k) & ")"
CTRp.Sheets("Summary").Cells(14 + k, 8).Formula = "=Sum(H13:H" & (12 + k) & ")"
CTRp.Sheets("Summary").Cells(14 + k, 9).Formula = "=Sum(I13:I" & (12 + k) & ")"
CTRp.Sheets("Summary").Cells(16 + k, 9).Formula = "=H" & k + 14 & "+I" & k + 14
CTRp.Sheets("MDR").Range("A" & (CTRp.Sheets("MDR").Cells(10000, 2).End(xlUp).Row + 2) & ":N10000").Clear
CTRp.Sheets("Inputs").Range("A" & (CTRp.Sheets("Inputs").Cells(10000, 2).End(xlUp).Row + 2) & ":N10000").Clear


For R = 13 To (12 + k)
    Found = ""
    lookfor = SL & CTRp.Sheets("Summary").Cells(R, 2).Value
    CTRFound = Application.VLookup(lookfor, ThisWorkbook.Sheets("Settings").Range("NameCodes"), 2, False)
    If IsError(CTRFound) = False Then CTRp.Sheets("Summary").Cells(R, 3).Value = CTRFound
Next R


CTRp.Sheets("Summary").Activate
End Sub
 
Upvote 0
The print area requires the Range address as a string.


Code: 
CTRp.Sheets("MDR").PageSetup.PrintArea = CTRp.Sheets("MDR").Range("A1:N" & CTRp.Sheets("MDR").Cells(10000, 2).End(xlUp).Row)[B].Address
[/B]
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Delete Name Ranges Except Print Area and Print Titles
Replies
8
Views
339
nhinx
N
F
  • Solved
Set up print area and avoid printing blank pages (VBA)
2 3
Replies
27
Views
2K
jolivanes
jolivanes
Y
  • Solved
Creating a Pie Chart based on a Dynamic Range
Replies
6
Views
280
Yeft
Y
Jeffrey Mahoney
  • Question Question
Named Range Area Number
Replies
3
Views
193
Jeffrey Mahoney
Jeffrey Mahoney
F
  • Question Question
Printing: File settings override code
Replies
1
Views
93
Flavien
F

Forum statistics

Threads
1,224,823
Messages
6,181,179
Members
453,021
Latest member
Justyna P

Share this page

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