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?
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
