Ark68
Well-known Member
- Joined
- Mar 23, 2004
- Messages
- 4,564
- Office Version
- 365
- 2016
- Platform
- Windows
I am struggling with how to proceed with coding a particular challenge. Consider this code, which calculates the sum of the heights of all the rows (ptrh) in each of 11 particular worksheets of my workbook. The idea is to produce a document (a lined gridlike form basically) that fills an entire 8.5 x 11 printed page. I know the height of combined rows needed to do this equals 579.75pts. Subtracting the sub of the row heights already on the page (within the defined range) equals variable ptrh. The difference in the two is how much space remain on the 8.5 x 11 sheet that needs to be populated with rows. In my case, a default row height is 12.75. Dividing the remaining page by 12.75 gives us a rough idea how many rows to add to fill the page.
I would like to now go one step further, but I have no idea how to do it with what I have so far.
If the sum of all the rows exceeds the max page allowance of 579.75 pts, I would like to insert a page break at this point. But, I need to complicate things a bit. The page break is to be before the last blank row available in the range that defines the max page allowance OR the row containing the value "Facility Maintenance Activities" in column A ... whichever comes first.
To me, this is an incredible challenge in not only figuring out how to do it, but to clearly explain it. I hope that the information I gave was adequate enough to give someone the info needed to help me tackle the issue.
I am unable to attach a sample to best illustrate the scenarios, so I will post a MrExcelHTML representation which poorly demonstrates the true perspective. (improper representation of row heights, unable to use colours to distinguish points of reference etc.)
Worksheet RPL1
The red line (row 45) indicates where Excel is automatically places the page break. The sum of all the rows 1:44 = 579.75 pts.
The green line (row 41) is the preferred location of the page break ... it's the last blank row is range rows 1:44.
Worksheet RPL2
The red line (row 46) indicates where Excel is automatically places the page break. The sum of all the rows 1:44 = 579.75 pts.
The green line (row 43) is the preferred location of the page break.
Special request ...
It would also be nice to be able to add 5 or 6 blank rows on the last page following any data in the Facility Maintenance Activity section providing it doesn't force a new page. This may be overextending my request for help, but if anyone is feeling a bit extra generous.
Code:
Sub fill_pages()
'fill pages (default height 643.5 pts)
With wb_womain
Dim dph As Double, cph As Double, markrow As Double, llrow As Double, diff As Double, rta As Double, a_pda As Double, a_fma As Double ', fmarow As Double
Dim Q As Range, lrow_fma As Double, Ac As Range, add_apda As Double, add_afma As Double 'lrow_pda As Double,
Dim ptrh As Double
Dim va As Object, po As Integer, fmarow As Integer, lrow_pda As Integer
dph = 579.75
arr4 = Array("Master", "CUE", "CUL", "HPE", "HPL", "RPE", "RPL", "CRP", "WPE", "WPL", "CWP")
For po = 0 To UBound(arr4)
Set va = Worksheets(arr4(po)) 'active worksheet
ptrh = 0
With va
.Activate
markrow = Application.WorksheetFunction.Match("mark", .Range("A1:A200"), 0)
llrow = markrow + 4
For Each Q In .Range("A1:A" & llrow)
ptrh = ptrh + Q.Height
Next Q
diff = dph - ptrh
rta = WorksheetFunction.RoundDown((diff / 12.75), 0)
'MsgBox "Default page height: 579.75 pts" & Chr(13) & "Current page height: " & ptrh & " pts" & Chr(13) & "Difference: " & diff & " pts" & Chr(13) & "Rows to add: " & rta
If rta > 0 Then
a_pda = WorksheetFunction.RoundDown((0.6 * rta), 0)
a_fma = rta - a_pda
fmarow = Application.WorksheetFunction.Match("Facility Maintenance Activities", .Range("A1:A200"), 0)
lrow_pda = fmarow - 3
Set Ac = ActiveSheet.Cells(lrow_pda, 1)
For add_apda = 1 To a_pda
Ac.offset(add_apda).EntireRow.Insert
Next add_apda
.Range("H" & lrow_pda + 1 & ":Q" & lrow_pda + a_pda).Interior.ColorIndex = RGB(0, 0, 0)
With .Range("B" & lrow_pda + 1 & ":B" & lrow_pda + a_pda).Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
fmarow = Application.WorksheetFunction.Match("mark", .Range("A1:A200"), 0)
lrow_fma = fmarow - 1
Set Ac = ActiveSheet.Cells(lrow_fma, 1)
For add_afma = 1 To a_fma
Ac.offset(add_afma).EntireRow.Insert
Next add_afma
End If
On Error Resume Next
.Range("A" & lrow_fma + a_fma) = ""
On Error GoTo 0
gh1 = Application.WorksheetFunction.Match("mark", .Range("A:A"), 0)
.Range("A" & gh1) = ""
End With
Next po
End With
End Sub
I would like to now go one step further, but I have no idea how to do it with what I have so far.
If the sum of all the rows exceeds the max page allowance of 579.75 pts, I would like to insert a page break at this point. But, I need to complicate things a bit. The page break is to be before the last blank row available in the range that defines the max page allowance OR the row containing the value "Facility Maintenance Activities" in column A ... whichever comes first.
To me, this is an incredible challenge in not only figuring out how to do it, but to clearly explain it. I hope that the information I gave was adequate enough to give someone the info needed to help me tackle the issue.
I am unable to attach a sample to best illustrate the scenarios, so I will post a MrExcelHTML representation which poorly demonstrates the true perspective. (improper representation of row heights, unable to use colours to distinguish points of reference etc.)
Worksheet RPL1
Excel 2010 | |||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | |||
1 | 20-Jun 8:10 PM | Tuesday June 20, 2017 | |||||||||||||||||
2 | |||||||||||||||||||
3 | |||||||||||||||||||
4 | RPL1 | ||||||||||||||||||
5 | 2:00P - 10:00P | ||||||||||||||||||
6 | |||||||||||||||||||
7 | |||||||||||||||||||
8 | Program Delivery Activities | Document times completed | |||||||||||||||||
9 | TOURNAMENT RELINING | ||||||||||||||||||
10 | Record ID | Dispatch | Rental | Location | Activity | Groom | Prepare | Signature | Lights On | Lights Off | 1 | 2 | 3 | 4 | Close | ||||
11 | |||||||||||||||||||
12 | |||||||||||||||||||
13 | 42906014 | 77786 | 12:00P | 5:00P | |||||||||||||||
14 | 42906016 | 77786 | 12:00P | 5:00P | |||||||||||||||
15 | 42906018 | 77786 | 12:00P | 5:00P | |||||||||||||||
16 | 42906021 | 77786 | 12:00P | 5:00P | |||||||||||||||
17 | 42906023 | 77786 | 12:00P | 5:00P | |||||||||||||||
18 | 42906025 | 77786 | 12:00P | 5:00P | |||||||||||||||
19 | |||||||||||||||||||
20 | 42906019 | CHANGE <5:30P | 77907 | 6:00P | 8:00P | ||||||||||||||
21 | 42906015 | <6:00P | 77808 | 6:30P | 11:00P | ||||||||||||||
22 | 42906017 | 77808 | 6:30P | 11:00P | |||||||||||||||
23 | 42906022 | 77808 | 6:30P | 8:00P | |||||||||||||||
24 | 42906024 | 77808 | 6:30P | 8:00P | |||||||||||||||
25 | 42906026 | 77808 | 6:30P | 8:00P | |||||||||||||||
26 | 42906020 | CHANGE <8:00P | 78948 | 8:30P | 10:30P | ||||||||||||||
27 | |||||||||||||||||||
28 | 42906031 | 77678 | 6:00P | 8:30P | |||||||||||||||
29 | 42906036 | 77678 | 6:00P | 8:30P | |||||||||||||||
30 | 42906038 | 77700 | 6:00P | 8:30P | |||||||||||||||
31 | 42906040 | 77700 | 6:00P | 8:30P | |||||||||||||||
32 | 42906042 | 77700 | 6:00P | 8:30P | |||||||||||||||
33 | 42906013 | 78284 | 6:30P | 9:00P | |||||||||||||||
34 | 42906033 | 77700 | 6:30P | 8:30P | |||||||||||||||
35 | 42906035 | 77678 | 6:30P | 8:30P | |||||||||||||||
36 | 42906012 | 78536 | 8:30P | 11:00P | |||||||||||||||
37 | 42906034 | 78085 | 8:30P | 10:30P | |||||||||||||||
38 | 42906039 | 78085 | 8:30P | 10:30P | |||||||||||||||
39 | 42906041 | 78085 | 8:30P | 10:30P | |||||||||||||||
40 | 42906043 | 78085 | 8:30P | 10:30P | |||||||||||||||
41 | |||||||||||||||||||
42 | 42906027 | 194438 | 6:30P | 8:00P | |||||||||||||||
43 | 42906028 | 194438 | 6:30P | 8:00P | |||||||||||||||
44 | 42906029 | 194438 | 6:30P | 8:00P | |||||||||||||||
45 | 42906030 | 194438 | 6:30P | 8:00P | |||||||||||||||
46 | |||||||||||||||||||
47 | |||||||||||||||||||
48 | Facility Maintenance Activities | document assigned and non-assigned maintenance activities | |||||||||||||||||
49 | |||||||||||||||||||
50 | W/O | Location | Activity | (Time) | Complete | Incomplete | Initials | ||||||||||||
51 | |||||||||||||||||||
52 | 2:30P-4:15P | ||||||||||||||||||
53 | |||||||||||||||||||
54 | |||||||||||||||||||
55 | >5:00P | ||||||||||||||||||
56 | >8:00P | ||||||||||||||||||
57 | >9:45P | ||||||||||||||||||
58 | |||||||||||||||||||
59 | |||||||||||||||||||
60 | |||||||||||||||||||
61 | Please use reverse for notes and comments | ||||||||||||||||||
62 | |||||||||||||||||||
RPL1 |
The red line (row 45) indicates where Excel is automatically places the page break. The sum of all the rows 1:44 = 579.75 pts.
The green line (row 41) is the preferred location of the page break ... it's the last blank row is range rows 1:44.
Worksheet RPL2
Excel 2010 | |||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | |||
1 | 20-Jun 8:10 PM | Tuesday June 20, 2017 | |||||||||||||||||
2 | |||||||||||||||||||
3 | |||||||||||||||||||
4 | RPL1 | ||||||||||||||||||
5 | 2:00P - 10:00P | ||||||||||||||||||
6 | |||||||||||||||||||
7 | |||||||||||||||||||
8 | Program Delivery Activities | Document times completed | |||||||||||||||||
9 | TOURNAMENT RELINING | ||||||||||||||||||
10 | Record ID | Dispatch | Rental | Location | Activity | Groom | Prepare | Signature | Lights On | Lights Off | 1 | 2 | 3 | 4 | Close | ||||
11 | |||||||||||||||||||
12 | |||||||||||||||||||
13 | 42906014 | 77786 | 12:00P | 5:00P | |||||||||||||||
14 | 42906016 | 77786 | 12:00P | 5:00P | |||||||||||||||
15 | 42906018 | 77786 | 12:00P | 5:00P | |||||||||||||||
16 | 42906021 | 77786 | 12:00P | 5:00P | |||||||||||||||
17 | 42906023 | 77786 | 12:00P | 5:00P | |||||||||||||||
18 | 42906025 | 77786 | 12:00P | 5:00P | |||||||||||||||
19 | |||||||||||||||||||
20 | 42906019 | CHANGE <5:30P | 77907 | 6:00P | 8:00P | ||||||||||||||
21 | 42906015 | <6:00P | 77808 | 6:30P | 11:00P | ||||||||||||||
22 | 42906017 | 77808 | 6:30P | 11:00P | |||||||||||||||
23 | 42906022 | 77808 | 6:30P | 8:00P | |||||||||||||||
24 | 42906024 | 77808 | 6:30P | 8:00P | |||||||||||||||
25 | 42906026 | 77808 | 6:30P | 8:00P | |||||||||||||||
26 | 42906020 | CHANGE <8:00P | 78948 | 8:30P | 10:30P | ||||||||||||||
27 | |||||||||||||||||||
28 | 42906031 | 77678 | 6:00P | 8:30P | |||||||||||||||
29 | 42906036 | 77678 | 6:00P | 8:30P | |||||||||||||||
30 | 42906038 | 77700 | 6:00P | 8:30P | |||||||||||||||
31 | 42906040 | 77700 | 6:00P | 8:30P | |||||||||||||||
32 | 42906034 | 78085 | 8:30P | 10:30P | |||||||||||||||
33 | 42906039 | 78085 | 8:30P | 10:30P | |||||||||||||||
34 | 42906041 | 78085 | 8:30P | 10:30P | |||||||||||||||
35 | 42906043 | 78085 | 8:30P | 10:30P | |||||||||||||||
36 | |||||||||||||||||||
37 | 42906027 | 194438 | 6:30P | 8:00P | |||||||||||||||
38 | 42906028 | 194438 | 6:30P | 8:00P | |||||||||||||||
39 | 42906029 | 194438 | 6:30P | 8:00P | |||||||||||||||
40 | 42906030 | 194438 | 6:30P | 8:00P | |||||||||||||||
41 | |||||||||||||||||||
42 | |||||||||||||||||||
43 | Facility Maintenance Activities | document assigned and non-assigned maintenance activities | |||||||||||||||||
44 | |||||||||||||||||||
45 | W/O | Location | Activity | (Time) | Complete | Incomplete | Initials | ||||||||||||
46 | |||||||||||||||||||
47 | 2:30P-4:15P | ||||||||||||||||||
48 | |||||||||||||||||||
49 | |||||||||||||||||||
50 | >5:00P | ||||||||||||||||||
51 | >8:00P | ||||||||||||||||||
52 | >9:45P | ||||||||||||||||||
53 | |||||||||||||||||||
54 | |||||||||||||||||||
55 | |||||||||||||||||||
56 | Please use reverse for notes and comments | ||||||||||||||||||
57 | |||||||||||||||||||
RPL2 |
The red line (row 46) indicates where Excel is automatically places the page break. The sum of all the rows 1:44 = 579.75 pts.
The green line (row 43) is the preferred location of the page break.
Special request ...
It would also be nice to be able to add 5 or 6 blank rows on the last page following any data in the Facility Maintenance Activity section providing it doesn't force a new page. This may be overextending my request for help, but if anyone is feeling a bit extra generous.