![]() |
Select entire rows if between date/time range
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 ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- |
Select entire rows if between date/time range
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 " wrote: 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 ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- |
Select entire rows if between date/time range
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 |
Select entire rows if between date/time range
I need to know what is suppose to be copied to get the code working properly.
Once that problem is solved then I can get everything working. " wrote: 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 |
Select entire rows if between date/time range
I have a 108 colums A:DD 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. |
All times are GMT +1. The time now is 12:12 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com