VBA to create proposal sheet(s)

padadof2

New Member
Joined
Jan 11, 2010
Messages
27
Good Morning and thank you for reading. This forum has been a tremendous help! I am new to VBA and self taught with youtube and these forums, so I apologize if my code is sloppy or poorly written. With that being said, I have a workbook that has our bid sheet. I am trying to create the proposal from the bid sheet using VBA. I have it now so that it's almost workable, but have a few questions.

I need to have the "Title Block" which is the 1st 7 rows of the proposal to be on every page that is needed. I have already set up the header to show info, and maybe I could use that, but the formatting in the headers was poor, if I remember correctly and I'd like to have automatic page breaks when the Disclaimer section goes to a 2nd, or even 3rd page.

How can I put the disclaimer section on the bottom of the last page when I don't know how many pages it will be, since it's dynamic with the amount of Items?

VBA Code:
Sub ProposalTesting()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Dim shB As Worksheet
    Dim shP As Worksheet
    Dim rng As Range
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim pr As Range
    Dim SheetName As Variant
    
    Set shB = ActiveSheet
    
    Dim checkSheetName As String
    SheetName = Application.InputBox("Who is this Proposal for?" _
    & vbCr & "Leave Blank for a generic Proposal" & _
    vbCr & "Cancel to quit.", "Mar-Allen Concrete, Inc.")
    
    If SheetName = False Then
        Exit Sub
    End If
        On Error Resume Next
            checkSheetName = Worksheets(SheetName & " Proposal").Name
        If checkSheetName = "" Then
            Worksheets.Add.Name = SheetName & " Proposal"
        Else
        MsgBox "The name is already used", vbInformation, "Mar-Allen Concrete, Inc."
        Exit Sub
        
        End If

    Set shP = Worksheets(SheetName & " Proposal")
    
        shP.Rows(1).RowHeight = 5
        shP.Rows(12).RowHeight = 5
        
        shP.Columns("A").ColumnWidth = 3.38
        shP.Columns("B").ColumnWidth = 10.38
        shP.Columns("C").ColumnWidth = 2.88
        shP.Columns("D:H").ColumnWidth = 8.38
        shP.Columns("I").ColumnWidth = 2.88
        shP.Columns("j").ColumnWidth = 13.13
        shP.Columns("K").ColumnWidth = 3.25
    
    With ActiveSheet.PageSetup
        .LeftMargin = _
            Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(1.5)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        
    End With

    'HEADER WITH LOGO SET UP
    
        shP.PageSetup.CenterHeader = ""
        shP.PageSetup.LeftHeader = "&G"
        shP.PageSetup.LeftHeaderPicture.FileName = "N:\Estimating 1\Mike\LOGO\MALOGO.JPG"
        shP.PageSetup.RightHeader = "&B&20&""Calibri""PROPOSAL" & Chr(13) _
        & "&B&10 Page &P of &N" & Chr(13) _
        & "&12 490 Millway Rd, Ephrata, PA 17522" & Chr(13) _
        & "Phone: (717) 859-4921  Fax: (717) 859-2666 &B"
        
    'NO Logo Header TEXT ONLY
    
        'shP.PageSetup.CenterHeader = "&B&16&""Calibri"" PROPOSAL" & Chr(13) _
        & "&30&""Latin Wide"" MAR-ALLEN" & Chr(13) _
        & "&12&""Calibri"" Concrete Products, Inc." & Chr(13) _
        & "&B 490 Millway Rd, Ephrata, PA 17522" & Chr(13) _
        & "Phone: (717) 859-4921  Fax: (717) 859-2666 &B"
    'FOOTER SET UP
        'shP.PageSetup.CenterFooter = "Page &P of &N"
        
        shP.Range("B2:K7").Font.Size = 10
        Range("B2:K7").Font.Name = "courier new"
        shP.Range("B2:K7").HorizontalAlignment = xlRight
        
        shP.Range("B2").Value = "Submitted to:"
        shP.Range("B2").Font.Bold = True
        shP.Range("C2:G2").Merge
        shP.Range("C2:G2").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
                
        shP.Range("I2").Value = "Attn:"
        shP.Range("I2").Font.Bold = True
        shP.Range("J2:K2").Merge
        shP.Range("J2:K2").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        

        shP.Range("B4").Value = "Job Name:"
        shP.Range("B4").Font.Bold = True
        shP.Range("C4:G4").Merge
        shP.Range("C4:G4").Value = Range("Name").Value & " " & Range("ECMS").Value
        shP.Range("C4:G4").HorizontalAlignment = xlLeft
        shP.Range("C4:G4").NumberFormat = "General"
        shP.Range("C4:G4").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        
        shP.Range("I4").Value = "Date:"
        shP.Range("I4").Font.Bold = True
        shP.Range("J4:K4").Merge
        shP.Range("J4:K4").HorizontalAlignment = xlLeft
        shP.Range("J4:K4").Value = "=today()"
        shP.Range("J4:K4").NumberFormat = "mm-dd-yyy"
        shP.Range("J4:K4").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        
        shP.Range("B6").Value = "Job Location:"
        shP.Range("B6").Font.Bold = True
        shP.Range("C6:G6").Merge
        shP.Range("C6:G6").HorizontalAlignment = xlLeft
        shP.Range("C6:G6").Value = "=LOC"
        shP.Range("C6:G6").NumberFormat = "General"
        shP.Range("C6:G6").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        
        shP.Range("I6").Value = "From:"
        shP.Range("I6").Font.Bold = True
        shP.Range("J6:K6").Merge
        shP.Range("J6:K6").HorizontalAlignment = xlLeft
        shP.Range("J6:K6").Value = "Joseph D. Groff"
        shP.Range("J6:K6").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        
        shP.Range("A7:K7").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDouble
        
        shP.Range("A8:K8").Merge
        shP.Range("A8:K8").Value = "We Propose to Furnish Labor (Std. Workweek of 4-10 Hr. Days), Material & Equipment to Perform the Following:"
        shP.Range("A8:K8").Font.Size = 7.5
        shP.Range("A8:K11").Font.Name = "Courier New"
        shP.Range("A11:K11").Font.Size = 10
        shP.Range("A8:K11").Font.Bold = False
        shP.Range("A8:K8").HorizontalAlignment = xlLeft
        
        shP.Range("B11").Value = "ITEM"
        shP.Range("B11").Font.Bold = True
        shP.Range("B11").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        shP.Range("B11").HorizontalAlignment = xlCenter
        
        shP.Range("F11").Value = "DESCRIPTION"
        shP.Range("F11").Font.Bold = True
        shP.Range("D11:H11").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        shP.Range("D11:H11").Merge
        shP.Range("D11:H11").HorizontalAlignment = xlCenter
        
        shP.Range("J11").Value = "PRICE"
        shP.Range("J11").Font.Bold = True
        shP.Range("J11:K11").Merge
        shP.Range("J11:K11").HorizontalAlignment = xlCenter
        shP.Range("J11:K11").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        

    Set rng = shB.Range("A9")
    
        i = 13
        j = 10
        k = 14
        
    ' Set Do loop to stop when an empty cell is reached.
    Do Until IsEmpty(rng.Value)
    ' Item
        shP.Cells(i, 2).Value = shB.Cells(j, 1).Value
        shP.Cells(i, 2).NumberFormat = "General"
        shP.Cells(i, 2).Font.Color = vbBlack
        shP.Cells(i, 2).Font.Name = "Times New Roman"
        shP.Cells(i, 2).Font.Bold = False
        shP.Cells(i, 2).HorizontalAlignment = xlCenter
        shP.Cells(i, 2).RowHeight = 13.5
        
    ' Item Name
        shP.Cells(i, 4).Value = shB.Cells(j, 2).Value
        shP.Cells(i, 4).NumberFormat = "General"
        shP.Cells(i, 4).Font.Color = vbBlack
        shP.Cells(i, 4).Font.Name = "Times New Roman"
        shP.Cells(i, 4).RowHeight = 13.5
        shP.Cells(i, 4).Font.Bold = False
        
    'Total Price
        shP.Cells(i + 1, 10).Value = shB.Cells(j, 12).Value
        shP.Cells(i + 1, 10).NumberFormat = "$#,##0.00"
        shP.Cells(i + 1, 10).Font.Color = vbBlack
        shP.Cells(i + 1, 10).Font.Name = "Times New Roman"
        shP.Cells(i + 1, 10).RowHeight = 13.5
        shP.Cells(i + 1, 10).Font.Bold = False
        
    'Repair Description
        If shB.Cells(j, 4) = "LS" Then
            shP.Cells(k, 4).Value = "Lump Sum"
            shP.Cells(k, 4).NumberFormat = "$#,##0.00"
            shP.Cells(k, 4).Font.Color = vbBlack
            shP.Cells(k, 4).Font.Name = "Times New Roman"
            shP.Cells(k, 4).WrapText = False
            shP.Cells(k, 4).HorizontalAlignment = xlLeft
            shP.Cells(k, 4).RowHeight = 13.5
            shP.Cells(k, 4).Font.Bold = False
        Else
            shP.Cells(k, 4).Value = "Approx. " & shB.Cells(j, 3) & " " & shB.Cells(j, 4) & " @ $ " & Format(Round(shB.Cells(j, 11), 2), "#,##0.00") & " / " & shB.Cells(j, 4)
            shP.Cells(k, 4).NumberFormat = "$#,##0.00"
            shP.Cells(k, 4).Font.Color = vbBlack
            shP.Cells(k, 4).Font.Name = "Times New Roman"
            shP.Cells(k, 4).WrapText = False
            shP.Cells(k, 4).HorizontalAlignment = xlLeft
            shP.Cells(k, 4).RowHeight = 13.5
            shP.Cells(k, 4).Font.Bold = False
        End If
        
        j = j + 1
        i = i + 3
        k = k + 3
            
        ' Step down 1 row from present location.
        
    Set rng = rng.Offset(1, 0)
        
    Loop
    
    Call Disclaimer(shP)
    
    Application.Calculation = xlCalculationAutomatic
    
    shP.Activate
    
    Application.ScreenUpdating = True
    
End Sub

Sub Disclaimer(ws As Worksheet)
      
Dim Last_Row As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    With ws
        Last_Row = .Cells(Rows.Count, 2).End(xlUp).Row
    
'NOTES SECTION
             .Range(.Cells(Last_Row + 3, 2), .Cells(Last_Row + 3, 2)).Value = "NOTES:"
             .Range(.Cells(Last_Row + 3, 2), .Cells(Last_Row + 3, 2)).HorizontalAlignment = xlCenter
             .Range(.Cells(Last_Row + 3, 2), .Cells(Last_Row + 3, 2)).Font.Bold = True
             .Range(.Cells(Last_Row + 3, 2), .Cells(Last_Row + 3, 2)).Font.Underline = True
        With .Range(.Cells(Last_Row + 3, 4), .Cells(Last_Row + 5, 11))
            .Font.Name = "calibri"
            .Merge
            .Font.Size = 9
            .WrapText = True
            .Font.Bold = False
            .HorizontalAlignment = xlLeft
            .RowHeight = 13.5
            .VerticalAlignment = xlTop
            .Value = "Insert Notes here.  IF you need more space, just insert a row, if you dont need any notes, delete these rows."
        End With
        
' Does not Include Section
        With .Range(.Cells(Last_Row + 7, 1), .Cells(Last_Row + 13, 11))
            .Font.Name = "calibri"
            .Merge
            .Font.Size = 9
            .WrapText = True
            .Font.Bold = False
            .HorizontalAlignment = xlLeft
            .RowHeight = 13.5
            .VerticalAlignment = xlCenter
            .Value = "Prices DO NOT include bonds, Overtime, Removal of Debris from work areas or Job Site, Maintenace & Protection of Traffic and Flagmen, Cold Weather Protection; Engineering Services: Covering or Uncovering of Walls, Floors, Pipes, Etc; Location, repair, removal, or replacement, etc. of any utilities, removal or abatement of any hazardous waste; any covering or protection of any kind, or flagmen for railroads; manufacturer representative services, demolition of any structure, dewatering of structure,  stream or environmental protection, or temporary shoring of structure while under repair; Railroad Protective Liability Ins. Prices include 2 million general liability insurance.  Work performed on a non-union basis or on a project agreement with union trades. Vehicles must be removed from property where work is being performed.  We will not be responsible for any damage done to vehicles which are not moved."""
        End With
        
'All Material is Guaranteed... SECTION
        With .Range(.Cells(Last_Row + 15, 1), .Cells(Last_Row + 19, 11))
            .Merge
            .Value = "All material is guaranteed to be as specified.  All work to be completed in a workmanlike manner according to standard practices.  Any alterations or deviation from above specifications involving extra costs will be executed only upon written orders and will become an extra charge over and above the estimate.  All agreements contingent upon strikes, accidents or delays beyond our control.  Owners to carry fire, tornado and other necessary insurance.  Our workers are fully covered by Workmen's Compensation Insurance"
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlCenter
            .Font.Name = "calibri"
            .Font.Bold = False
            .Font.Size = 9
            .WrapText = True
        End With
        
'Signature Lines
        With .Range(.Cells(Last_Row + 20, 2), .Cells(Last_Row + 20, 2))
            .Value = "Authorized Signature:"
            .HorizontalAlignment = xlRight
            .Font.Name = "cambria"
            .Font.Bold = True
            .Font.Size = 8.5
            .WrapText = False
            .RowHeight = 16
        End With
        With .Range(.Cells(Last_Row + 20, 11), .Cells(Last_Row + 20, 11))
            .Value = "Withdrawn within 30 Days"
            .HorizontalAlignment = xlRight
            .Font.Name = "cambria"
            .Font.Bold = True
            .Font.Size = 8.5
            .WrapText = False
        End With
            .Range(.Cells(Last_Row + 20, 3), .Cells(Last_Row + 20, 9)).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
            .Range(.Cells(Last_Row + 14, 1), .Cells(Last_Row + 14, 11)).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDouble
            
'Proposal Acceptance SECTION
        With .Range(.Cells(Last_Row + 22, 1), .Cells(Last_Row + 23, 11))
            .Borders(xlEdgeTop).LineStyle = XlLineStyle.xlDouble
            .Merge
            .Value = "Acceptance of Proposal - The above prices, specifications and conditions are satisfactory and are hereby accepted.  You are authorized to do the work as specified.  Payment will be made as outlined above."
            .Font.Name = "calibri"
            .Font.Size = 9
            .Font.Bold = False
            .WrapText = True
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlCenter
            .RowHeight = 16
        End With
' Signature Acceptance SECTION
        .Range(.Cells(Last_Row + 24, 2), .Cells(Last_Row + 24, 2)).Value = "Date of Acceptance:"
        .Range(.Cells(Last_Row + 24, 2), .Cells(Last_Row + 24, 2)).RowHeight = 20
        .Range(.Cells(Last_Row + 24, 2), .Cells(Last_Row + 24, 2)).Font.Size = 9.5
        .Range(.Cells(Last_Row + 24, 6), .Cells(Last_Row + 24, 6)).Value = "Signature:"
        .Range(.Cells(Last_Row + 24, 2), .Cells(Last_Row + 24, 6)).Font.Bold = True
        .Range(.Cells(Last_Row + 24, 2), .Cells(Last_Row + 24, 6)).HorizontalAlignment = xlRight
        .Range(.Cells(Last_Row + 24, 2), .Cells(Last_Row + 24, 6)).VerticalAlignment = xlBottom
        .Range(.Cells(Last_Row + 24, 2), .Cells(Last_Row + 24, 6)).WrapText = False
        .Range(.Cells(Last_Row + 24, 6), .Cells(Last_Row + 24, 6)).Font.Size = 10
        .Range(.Cells(Last_Row + 24, 2), .Cells(Last_Row + 24, 6)).Font.Name = "cambria"
        .Range(.Cells(Last_Row + 24, 3), .Cells(Last_Row + 24, 5)).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        .Range(.Cells(Last_Row + 24, 7), .Cells(Last_Row + 24, 11)).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
   End With
  
End Sub
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,647
Office Version
  1. 365
Platform
  1. Windows
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: vba to create proposals
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 

padadof2

New Member
Joined
Jan 11, 2010
Messages
27
I posted this question to this forum after I didn't get any responses from excelforum asking for the same help. The same question can be found at excelforum. I am hoping someone can get me started in the right direction and apologize to both forums for posting the same question on each forum. Didn't realize the issue
 

Watch MrExcel Video

Forum statistics

Threads
1,127,798
Messages
5,626,941
Members
416,209
Latest member
tan21

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
Top