Printing Cells with Values plus corresponding cells two rows over

Question

Question: Is there a way to have excel recognize cells that have been recently modified or look in column A and just print down to the last data entered instead of printing like 400 pages because my formula goes to row 999 in column D.

I currently have a workbook that has my team put data in to column A and then the macro pulls information from two sources using the data and then does a formula in column D. The print function I built asks the teammate how many rows of data they put in then uses the print select option to select the rows plus the header and print. (it also puts in todays date in column E but I have it hidden by having it in white font that turns black when printed).

Below is my current Code thanks for any help in tweaking it

Private Sub PrintArea()
Dim Row As Long
On Error GoTo 1

Row = Application.InputBox("How Many Rows")

Worksheets("Data").Range("E1").Font.Color = vbBlack
ActiveSheet.Range(Cells(1, 1), Cells(Row + 1, 5)).Select

ActiveSheet.PageSetup.PrintArea = Selection.Address

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
End With

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Worksheets("Data").Range("E1").Font.Color = vbWhite
Range(Cells(2, 1), Cells(250, 3)).ClearContents


1:  Exit Sub

End Sub

Answer 1

You can use .End(xlDown) to get the last empty cell of any column. This will give you a more accurate range. Here's a slightly modified version of your code.

Private Sub PrintArea()

On Error GoTo 1

Dim i As Integer, k As Integer, j As Integer 'I add these usable integer variables for everything.
Dim Report As Worksheet, bReport As Workbook 'Create a worksheet and workbook variable...once again I add these to everything (just in case I need them later).

Set Report = Excel.ActiveSheet 'Set the report variable to your active worksheet.

k = Report.Cells(1, 1).EntireColumn.End(xlDown) 'SEE EDIT AT BOTTOM 'Here we get the last cell in the first column that has a value. You can change this to another column if need be.


Worksheets("Data").Range("E1").Font.Color = vbBlack
Report.Range(Cells(1, 1), Cells(r + 1, 5)).Select

Report.PageSetup.PrintArea = Selection.Address

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
End With

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Worksheets("Data").Range("E1").Font.Color = vbWhite
Range(Cells(2, 1), Cells(250, 3)).ClearContents


1:  Exit Sub

End Sub

---

EDIT

After I got a minute to review the code, it looks like I misused .End(xlDown) in the above example. Instead use the following to pull the last cell of that column that contains a value:

k = Report.Cells(Report.UsedRange.Rows.Count + 1, 1).End(xlUp).Row

Answer 2

Lopsided got me super close I dont have the rep to +1 him or I would but here is the answer I found that worked for me.

What I changed is

Dim R as Integer

R = Range("A65536").End(xlUp).Row

and

ActiveSheet.Range(Cells(1, 1), Cells(R, 5)).Select 

This made the selection accurate and solved the problem.

thanks again Lopsided

Below is the full code

Private Sub PrintArea()
Dim R As Integer
On Error GoTo 1

R = Range("A65536").End(xlUp).Row

Worksheets("Data").Range("E1").Font.Color = vbBlack
ActiveSheet.Range(Cells(1, 1), Cells(R, 5)).Select

ActiveSheet.PageSetup.PrintArea = Selection.Address

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
End With

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Worksheets("Data").Range("E1").Font.Color = vbWhite
Range(Cells(2, 1), Cells(250, 3)).ClearContents


1:  Exit Sub

End Sub

Answer 3

Well you could add a worksheet_change event handler. Whenever a user makes some changes the macro could record the changes made in another sheet for later use:

Private Sub Worksheet_Change(ByVal Target As Range)
    ' or check for any other range
    If Target.Address = Range("A1").Address Then
        'your code
    End If 
End Sub