PDA

View Full Version : [SOLVED] Print a changing range based on date values



pcarmour
03-23-2014, 08:29 AM
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

11435

p45cal
03-23-2014, 12:43 PM
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

mancubus
03-23-2014, 01:15 PM
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

pcarmour
03-23-2014, 01:45 PM
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.

snb
03-24-2014, 10:24 AM
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

pcarmour
03-24-2014, 02:22 PM
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

snb
03-25-2014, 01:13 AM
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