Select entire rows if between date/time range

[s_smith_iet]

Hey,

I have a code that selects between two dates and then goes to another
sheet and looks for all cells (in colum A) that are between thoes
dates and copies the entire row into another spread sheet and emails
it.

Problem is that is not selecting the any of the lines.

Can you please take a look at my code and tell me what I am doing
wrong.

Thanks




----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Workbooks.Open Filename:= _
"\\mascarolinabdc\puball\Data log trending Version 2.0\email sheets
\Cycle email P102.xls"
Sheets("sheet1").Select
Rows("3:200").ClearContents

Workbooks("Data log Trending V2.0.xls").Activate
Sheets("sheet2").Visible = True
Sheets("sheet2").Select
Range("B10").Select
ActiveCell.FormulaR1C1 = "=NOW()-1"

Workbooks.Open Filename:= _
"\\mascarolinabdc\puball\Data log trending Version 2.0\Data log
trending\P102 Datalog trending.xls"
Sheets("Cycles with problems ").Visible = True


Workbooks("P102 Datalog trending.xls").Activate
Sheets("Cycles with problems ").Select

Dim sDate As Date, fDate As Date
Dim ws1 As Worksheet
Set ws1 = Workbooks("P102 Datalog trending.xls").Worksheets("Cycles
with problems ") '<== Change as required

ws1.Activate
With ws1
'assumes dates are in colum A
lastrow = .Cells(Rows.Count, 1).End(xlUp).row
sDate = Workbooks("Data log Trending
V2.0.xls").Worksheets("sheet2").Range("C30").Value
fDate = Workbooks("Data log Trending
V2.0.xls").Worksheets("sheet2").Range("B30").Value
Set dateRng = Range("a1:a" & lastrow)
r = Application.Match(CLng(sDate), dateRng, 1)
If IsError(r) Then
frow = 2 ' first row i.e. start date is before first date in
column A
Else
frow = r
End If
lrow = Application.Match(CLng(fDate), dateRng, 1)

End With

Selection.Copy
Workbooks("Cycle email P102.xls").Activate
Sheets("sheet1").Select
Range("A3").PasteSpecial
Rows("3:3").Select
Selection.Delete Shift:=xlUp
Workbooks("Data log Trending V2.0.xls").Activate
Sheets("sheet2").Select
Range("B30").Select
Selection.Copy
Range("C30").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets("sheet2").Visible = False


Workbooks("Cycle email P102.xls").Activate
Workbooks("P102 Datalog trending.xls").Activate
Sheets("Cycles with problems ").Visible = False
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "Blank.com"
.CC = ""
.BCC = ""
.Subject = "P102 cycles with issue"
.Body = "Please see attached spread sheet for the latest
datalogs with issues"
.Attachments.Add ("\\mascarolinabdc\puball\Data log trending
Version 2.0\email sheets\Cycle email P102.xls")
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

Workbooks("Data log Trending V2.0.xls").Activate
Sheets("sheet2").Visible = False


Workbooks("Cycle email P102.xls").Save
Workbooks("Cycle email P102.xls").Close
Workbooks("P102 Datalog trending.xls").Save
Workbooks("P102 Datalog trending.xls").Close
Workbooks("Data log Trending V2.0.xls").Activate
Sheets("sheet2").Visible = False
Sheets("sheet1").Select
MsgBox ("Email sent")

End Sub

----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

 

[Joel]

This is how I would write the code. You have one line of code that I can't
resolve
Selection.Copy

I can't terll what is suppose to be selected.


Sub test()

Set EmailBk = Workbooks.Open(Filename:= _
"\\mascarolinabdc\puball\Data log trending Version 2.0\" & _
"email sheets\Cycle email P102.xls")
With EmailBk.Sheets("sheet1")
.Rows("3:200").ClearContents
End With

Set DataLogBk = Workbooks("Data log Trending V2.0.xls")
With DataLogBk
.Sheets("sheet2").Visible = True
.Sheets("sheet2").Range("B10") = _
FormulaR1C1 = "=NOW()-1"
End With

Set TrendingBk = Workbooks.Open(Filename:= _
"\\mascarolinabdc\puball\Data log trending Version 2.0\" & _
"Data log trending\P102 Datalog trending.xls")
With TrendingBk
.Sheets("Cycles with problems ").Visible = True

Dim sDate As Date, fDate As Date
Dim ws1 As Worksheet
Set ws1 = .Worksheets("Cycles with problems ") '<== Change as required

With ws1
'assumes dates are in colum A
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
End With

With .Worksheets("sheet2")
sDate = .Range("C30").Value
fDate = .Range("B30").Value
Set dateRng = .Range("a1:a" & lastrow)
r = Application.Match(CLng(sDate), dateRng, 1)
If IsError(r) Then
frow = 2 ' first row i.e. start date is before first date in
Column A
Else
frow = r
End If
lrow = Application.Match(CLng(fDate), dateRng, 1)
End With
End With
'---------------- what is suppose to be selected??? ---------------
Selection.Copy
'--------------------------------------------------------------------

With EmailBk.Sheets("sheet1")
.Range("A3").PasteSpecial
.Rows("3:3").Delete Shift:=xlUp
End With

With TrendingBk.Sheets("sheet2")
.Range("B30").Copy
.Range("C30").PasteSpecial _
Paste:=xlValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Application.CutCopyMode = False
.Visible = False
End With

TrendingBk.Sheets("Cycles with problems ").Visible = False

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "Blank.com"
.CC = ""
.BCC = ""
.Subject = "P102 cycles with issue"
.Body = "Please see attached spread sheet for the latest " & _
"datalogs with issues"

.Attachments.Add ("\\mascarolinabdc\puball\Data log trending " & _
"Version 2.0\email sheets\Cycle email P102.xls")
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

With TrendingBk
.Sheets("sheet2").Visible = False
End With

EmailBk.Close savechanges:=True
With TrendingBk
.Close savechanges:=True
.Sheets("sheet2").Visible = False
.Sheets("sheet1").Select
End With

MsgBox ("Email sent")

End Sub

 

[s_smith_iet]

I removed that line of code and used your code. But it is still doing
the same thing.

It won't select between the dates it only selects the first line in
the sheet and emails it.

Please help

 

[s_smith_iet]

I have a 108 colums AD that have data in them in p102 datlog
trending
A1:Ainfinity have dates/time in them (i.e. 10/11/08 7:15:52 PM)

B30 and C30 in datalog trending version 2.0 sheet 2 have the dates/
time I want the macro to use to copy and paste the data to p102 email
sheet sheet 1.