Consulting

Results 1 to 7 of 7

Thread: Print a changing range based on date values

  1. #1
    VBAX Contributor
    Joined
    Nov 2012
    Location
    Billericay, Essex
    Posts
    145
    Location

    Print a changing range based on date values

    Hi,
    I have a spreadsheet where I want users to be able to print data for last week (with black border) or this month with red border.
    Please see attached.
    I am working with Windows Home Premium version 6.1.7601 SP 1 Build 7601and Excel version 14.0.6123.5001 (32 bit)
    Very grateful for any help

    test.xlsm
    Regards, Peter.

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    try:
    Sub Print_Week()
    Dim rngToPrint As Range
    Set rngToPrint = PrintRange(Range("A12").Value, Range("A14").Value, Intersect(ActiveSheet.UsedRange, Columns(3)))
    'rngToPrint.Select 'debug line
    ActiveSheet.PageSetup.PrintArea = rngToPrint.Address
    ActiveWindow.SelectedSheets.PrintPreview
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1
    End Sub
    Sub Print_Month()
    Dim rngToPrint As Range
    Set rngToPrint = PrintRange(Range("A17").Value, Range("A19").Value, Intersect(ActiveSheet.UsedRange, Columns(3)))
    'rngToPrint.Select 'debug line
    ActiveSheet.PageSetup.PrintArea = rngToPrint.Address
    ActiveWindow.SelectedSheets.PrintPreview
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1
    End Sub
    Function PrintRange(FirstDate, LastDate, DatesRange) As Range
    For Each cll In DatesRange.Cells
      If Len(cll.Value) = 8 Then
        cllDate = DateSerial(Left(cll.Value, 4), Mid(cll.Value, 5, 2), Mid(cll.Value, 7, 2))
        If cllDate >= FirstDate And cllDate <= LastDate Then
          If PrintRange Is Nothing Then Set PrintRange = cll Else Set PrintRange = Union(PrintRange, cll)
        End If
      End If
    Next cll
    Set PrintRange = PrintRange.Resize(, 23)
    End Function
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    this thread had no replies when i started to work on it.

    Sub Print_Week()
    
        Dim i As Long, StartRow As Long, EndRow As Long
        
        With ActiveSheet
            .PageSetup.PrintArea = ""
            For i = 5 To .Range("C" & .Rows.Count).End(xlUp).Row
                .Range("C" & i) = DateSerial(Left(.Range("C" & i), 4), Mid(.Range("C" & i), 5, 2), Right(.Range("C" & i), 2))
            Next
            .Range("C5:C" & .Range("C" & .Rows.Count).End(xlUp).Row).NumberFormat = "m/d/yyyy"
            StartRow = .Columns(3).Find(.Range("A12"), , , , xlByRows, xlNext).Row
            EndRow = .Columns(3).Find(.Range("A14"), , , , xlByRows, xlNext).Row
            .PageSetup.PrintArea = .Range(.Cells(StartRow, "C"), .Cells(EndRow, "Y")).Address
        End With
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
    
    End Sub

    Sub Print_Month()
        
        Dim i As Long, StartRow As Long, EndRow As Long
        
        With ActiveSheet
            .PageSetup.PrintArea = ""
            For i = 5 To .Range("C" & .Rows.Count).End(xlUp).Row
                .Range("C" & i) = DateSerial(Left(.Range("C" & i), 4), Mid(.Range("C" & i), 5, 2), Right(.Range("C" & i), 2))
            Next
            .Range("C5:C" & .Range("C" & .Rows.Count).End(xlUp).Row).NumberFormat = "m/d/yyyy"
            StartRow = .Columns(3).Find(.Range("A17"), , , , xlByRows, xlNext).Row
            EndRow = .Columns(3).Find(.Range("A19"), , , , xlByRows, xlNext).Row
            .PageSetup.PrintArea = .Range(.Cells(StartRow, "C"), .Cells(EndRow, "Y")).Address
        End With
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
    
    End Sub
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  4. #4
    VBAX Contributor
    Joined
    Nov 2012
    Location
    Billericay, Essex
    Posts
    145
    Location
    Hi 45cal and mancubus,
    Thank you both for excellent solutions they both work brilliantly.
    VBA Express yet again proves to be the site and forum to get accurate and fast answers.
    Thank you again.
    Regards, Peter.

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Sub M_Week_snb()
        with sheet1
           .Columns(3).AutoFilter 1, Format(Date - Weekday(Date, 2), "\>yyyymmdd"), xlAnd, Format(Date - Weekday(Date, 2) + 7, "\<yyyymmdd")
           .PageSetup.PrintArea = .Columns(3).SpecialCells(12).Areas(2).Resize(, 23).Address
           .Columns(3).AutoFilter
           .PrintOut , , 1
       end with
    End Sub
    Sub M_Month_snb()
        with sheet1
          .Columns(3).AutoFilter 1, Format(Date - Day(Date), "\>yyyymmdd"), xlAnd, Format(DateSerial(Year(Date), Month(Date) + 1, 1), "\<yyyymmdd")
          .PageSetup.PrintArea = .Columns(3).SpecialCells(12).Areas(2).Resize(, 23).Address
          .columns(3).AutoFilter
          .PrintOut , , 1
       end with
    End Sub

  6. #6
    VBAX Contributor
    Joined
    Nov 2012
    Location
    Billericay, Essex
    Posts
    145
    Location
    Hi snb,

    Good to hear from you.
    Thank you for replying to another thread of mine.
    Your code for the Months print works exactly as I need, I now have three options on how to do it. The VBA for the week for some reason isn't working for me but please do not spend any more of your time on this as I do have a working option.
    Thank you again for your expertise.
    Regards,
    Peter
    Regards, Peter.

  7. #7
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    My code selects the present week.

    I had hoped you would have adapted the code for the last week yourself:

    Sub M_Week_snb()
        With Sheet1
            .Columns(3).AutoFilter 1, Format(Date - Weekday(Date, 2) - 7, "\>yyyymmdd"), xlAnd, Format(Date - Weekday(Date, 2), "\<yyyymmdd")
            .PageSetup.PrintArea = .Columns(3).SpecialCells(12).Areas(2).Resize(, 23).Address
            .Columns(3).AutoFilter
            .PrintOut , , 1
        End With
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •