Copy if date => now() <= Now() + 7 ?

[gibbo1715]

What i need to do is copy an entire row only if the date in column E is between today and 7 days ahead, i ve got the code below



Dim cl As Range
Dim Due As Date
Due = Now() + 7
MsgBox Due
Sheets("Sheet1").Select
Range("A3:K500").ClearContents
With Worksheets("Jan")
For Each cl In .Range("E3:E" & .Range("E65536").End(xlUp).Row)
If cl.Value < Due Then
cl.EntireRow.Copy Worksheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next cl
End With


But seems to copy the data regardless of whether it meets the if criteria?

Any Ideas



:dunno

[Jacob Hilderbrand]

Try this:


If cl.Value >= Date And cl.Value <= Date+7 Then

[gibbo1715]

Thanks Jake, thats better than the way i was gonna do it

only other thing i was wondering was that i have about 30 sheets in my workbook and i only want to run the search on 12 of them Jan, Feb, March etc.... is there an easy way to just loop through those 12 sheets only?

[Jacob Hilderbrand]

If the sheets you want are gouped together you can do this.


For i = 1 to 12
With Sheets(i)
'Code Here
End With
Next i


If they are not grouped together you can do this.

For Each ws In Worksheets
Select Case ws.Name
Case Is = "Jan", "Feb", "Mar" 'etc.
With ws
'Code Here
End With
End Select
Next

[gibbo1715]

Thanks Jake

Solved again

[gibbo1715]

For anyone with a similar issue heres the completed code

Gibbo


Dim cl As Range
Dim ws As Worksheet
Sheets("CaseDirBail").Select
Range("A3:K500").ClearContents
For Each ws In Worksheets
Select Case ws.Name
Case Is = "Jan", "Feb", "Mar", "April", "May", "June", "July", "Aug", "Sept", "Oct", "Nov", "Dec"
With ws
For Each cl In .Range("E3:E" & .Range("E65536").End(xlUp).Row)
If cl.Value >= Date And cl.Value <= Date + 7 Then
cl.EntireRow.Copy Worksheets("CaseDirBail").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next cl
End With
End Select
Next

[Jacob Hilderbrand]

You're Welcome :beerchug:

Take Care

[Ken Puls]

Hey there,

Another alternative for looping through the sheets (only because I used this very recently). They don't need to be grouped, but they do need a consistent date format. (Ie either use the full month name or the three digit abbrevation, but not a mix as you have currently)

Sub alternative()
Dim i As Long, cl As Range

'Loop through each monthly sheet
For i = 1 To 12
'Change "mmmm" below to "mmm" for 3 digit month
With Sheets(Format(DateSerial(Year(Sheets("Utils").Range("StartDate")), i, 1), "mmmm"))
For Each cl In .Range("E3:E" & .Range("E65536").End(xlUp).Row)
If cl.Value >= Date And cl.Value <= Date + 7 Then
cl.EntireRow.Copy Worksheets("CaseDirBail").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next cl
End With
Next i
End Sub

Cheers,