Sub caller()
'edit the sheet you want to do this for
Call DeleteOutsideOfPrintArea(Sheets("sheet1"))
End Sub
Sub DeleteOutsideOfPrintArea(WS As Worksheet)
Dim c As Range
For Each c In NonEmptyCells(WS.Cells).Cells
If Not Intersect(c, WS.Range(WS.PageSetup.PrintArea)) Then
c.ClearContents
End If
Next
End Sub
Function NonEmptyCells(TestRange As Range) As Range
Dim r1 As Range
Dim r2 As Range
If Not TestRange.Cells.Count > 1 Then
Set NonEmptyCells = TestRange
Exit Function
End If
On Error Resume Next
Set r1 = TestRange.SpecialCells(xlCellTypeFormulas)
Set r2 = TestRange.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If r1 Is Nothing And Not r2 Is Nothing Then
Set NonEmptyCells = r2
ElseIf r2 Is Nothing And Not r1 Is Nothing Then
Set NonEmptyCells = r1
ElseIf r2 Is Nothing And r1 Is Nothing Then
Set NonEmptyCells = TestRange.Cells(1, 1)
Else
Set NonEmptyCells = Union(r1, r2)
End If
End Function
'run this to clear all worksheets
Sub WorkbookClearOutsidePrint()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
DeleteOutsideOfPrintArea ws
Next
End Sub
Sub DeleteOutsideOfPrintArea(ws As Worksheet)
Dim c As Range
For Each c In NonEmptyCells(ws.Cells).Cells
If Intersect(c, ws.Range(ws.PageSetup.PrintArea)) Is Nothing Then
c.ClearContents
End If
Next
End Sub
Function NonEmptyCells(TestRange As Range) As Range
Dim r1 As Range
Dim r2 As Range
Dim dCellCount As Double
If Int(Application.Version) >= 12 Then
dCellCount = TestRange.Cells.CountLarge
Else
dCellCount = TestRange.Cells.Count
End If
If Not TestRange.Cells.CountLarge > 1 Then
Set NonEmptyCells = TestRange
Exit Function
End If
On Error Resume Next
Set r1 = TestRange.SpecialCells(xlCellTypeFormulas)
Set r2 = TestRange.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If r1 Is Nothing And Not r2 Is Nothing Then
Set NonEmptyCells = r2
ElseIf r2 Is Nothing And Not r1 Is Nothing Then
Set NonEmptyCells = r1
ElseIf r2 Is Nothing And r1 Is Nothing Then
Set NonEmptyCells = TestRange.Cells(1, 1)
Else
Set NonEmptyCells = Union(r1, r2)
End If
End Function