The macro below generates a roster of people, and then a signature block for the reviewing officer to sign at the bottom of the page. The length of the roster changes, and sometimes the signature block gets split crossed between pages when printed. It's ok if the block is entirely on a page by itself because the roster is just that perfect length, and it's also definitely ok if the signature block is entirely on the last roster page below the last roster data row. I'm looking for a way for Excel to choose one or the other based on the roster length so that it is never interrupted by the page break. If it helps, a full sheet contains two header rows, plus 40 roster data rows.
Code:
Sub cpypste5()
Dim x As String
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Main Data")
Dim ws2 As Worksheet
Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, multiAreaRange As Range
Dim c As Range
Dim Lr As Long
Set r1 = ws1.Range("B B")
Set r2 = ws1.Range("C:C")
Set r3 = ws1.Range("E E")
Set r4 = ws1.Range("F F")
Set r5 = ws1.Range("H:H")
If ws1.Range("$C$4") = "1" Then '//Uses Period # from Main Data sheet
Set ws2 = ThisWorkbook.Sheets("P1 Figure 2—2") 'to direct data to the correct period's
ElseIf ws1.Range("$C$4") = "2" Then 'Figure 2—2
Set ws2 = ThisWorkbook.Sheets("P2 Figure 2—2") '
ElseIf ws1.Range("$C$4") = "3" Then 'Max of 8 Periods
Set ws2 = ThisWorkbook.Sheets("P3 Figure 2—2") '
ElseIf ws1.Range("$C$4") = "4" Then '
Set ws2 = ThisWorkbook.Sheets("P4 Figure 2—2") '
Else: Exit Sub '
End If //
Set multiAreaRange = Union(r1, r2, r3, r4, r5)
Application.ScreenUpdating = False
x = "NO"
ws2.Rows("3:" & Rows.Count).Delete 'Clears Figure 2-2 selected above
If Not IsError(Application.Match(x, ws1.Range("A:A"), 0)) Then '//Copy and paste Name, TLD#, & Dates
'from Main Data page to Figure 2—2
ws1.Range("E:F").EntireColumn.Hidden = False 'above for all members with
' "NO" ERC.
ws1. Range("A3"). CurrentRegion. AutoFilter Field:=1, Criteria1:=x '
Intersect(ws1.AutoFilter.Range.Offset(1), multiAreaRange).Copy _
Destination: =ws2.Range("A" & Rows.Count).End(xlUp).Offset(1) '
ws1.AutoFilterMode = False '
'
ws1.Range("E:F").EntireColumn.Hidden = True '
'
End If '//
SortGroup2Printout 'Alphabetizes Figure 2-2
ws2.Range("A:F").Interior.ColorIndex = xlNone 'Removes any background color copied over
Lr = ws2.Range("A" & Rows.Count).End(xlUp).Row
If Lr > 2 Then
ws2.Range("F3:F" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,8,FALSE)"
ws2.Range("G3:G" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,9,FALSE)"
ws2.Range("H3:H" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,10,FALSE)"
ws2.Range("I3:I" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,11,FALSE)"
ws2.Range("J3:J" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,12,FALSE)"
ws2.Range("K3:K" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,13,FALSE)"
ws2.Range("L3:L" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,14,FALSE)"
ws2.Range("M3:M" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,15,FALSE)"
If ws1.Range("$C$4") = "1" Then
ws2.Range("N3:N" & Lr).Formula = "=E3-F3"
ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,8,FALSE)"
ElseIf ws1.Range("$C$4") = "2" Then
ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:G3)"
ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,9,FALSE)"
ElseIf ws1.Range("$C$4") = "3" Then
ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:H3)"
ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,10,FALSE)"
ElseIf ws1.Range("$C$4") = "4" Then
ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:I3)"
ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,11,FALSE)"
ElseIf ws1.Range("$C$4") = "5" Then
ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:J3)"
ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,12,FALSE)"
ElseIf ws1.Range("$C$4") = "6" Then
ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:K3)"
ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,13,FALSE)"
ElseIf ws1.Range("$C$4") = "7" Then
ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:L3)"
ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,14,FALSE)"
ElseIf ws1.Range("$C$4") = "8" Then
ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:M3)"
ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,15,FALSE)"
End If
Else
End If
Run ("clearzeros") 'Removes zeros from column O based on verification
For Each c In ws2.Range("C3:D" & Lr) '//Removes issue/collection dates
If c > Date Then 'if they are in the future.
c = "" '
Else '
End If '
Next '//
With ws2
With Application.ErrorCheckingOptions
.BackgroundChecking = False
.EvaluateToError = False
.InconsistentFormula = False
End With
End With
ws2.Range("A1:O" & Lr).Borders.LineStyle = xlContinuous
ws2.Range("A1:0" & Lr).BorderAround _
ColorIndex:=1, Weight:=xlMedium
With ws2.Range("A" & Rows.Count).End(xlUp).Offset(5, 1) '//Places CRA Review Box 4 rows
.Value = "Closeout Review: _______________ Date: _________" 'under last data row.
With ws2.Range("A” & Rows.Count).End(xlUp).Offset(6, 1) '
.Value = " CRA" '
End With '
.Resize(3, 13).Offset(-1, 0).BorderAround _
ColorIndex:=1, Weight:=xlMedium '
End With '//
Application.ScreenUpdating = True
End Sub
