Macros to search for date, copy full row and paste in different spreadsheet

[shefer13]

Hi guys,

I need your help. I'm trying to find a macro that will search for a particular date within the spreadsheet. once found copy all rows that contain this date in column A and paste in another spreadsheet.

The spreadsheet contains in column a date , column b to column x different data text, numbers etc.

Please help.

 

[Peter_SSs]

Welcome to the MrExcel board!

Does this do what you want?
(Suggest testing in a copy of your workbook)

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> CopyDateRows()<br>    <SPAN style="color:#00007F">Const</SPAN> myDate <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "5 July 2011"<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    ActiveSheet.Copy After:=ActiveSheet<br>    <SPAN style="color:#00007F">With</SPAN> ActiveSheet.UsedRange.Columns(1)<br>        .AutoFilter Field:=1, Criteria1:= _<br>            "<>" & <SPAN style="color:#00007F">CLng</SPAN>(DateValue(myDate))<br>        .Offset(1).EntireRow.Delete<br>        .AutoFilter<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[shefer13]

Hi Peter,
Thank you for your quick reply.

Its almost what I was looking for. I also need for the macro to allow me to input the search date and then search for it. In other words is it possible to add a script wher the box pops up and you can type the date(criteria) for the macro to search.

Thanks

 

[Peter_SSs]

Sure, try this one.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> CopyDateRows()<br>    <SPAN style="color:#00007F">Dim</SPAN> myDate <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    myDate = InputBox("Enter Date")<br>    <SPAN style="color:#00007F">If</SPAN> IsDate(myDate) <SPAN style="color:#00007F">Then</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>        ActiveSheet.Copy After:=ActiveSheet<br>        <SPAN style="color:#00007F">With</SPAN> ActiveSheet.UsedRange.Columns(1)<br>            .AutoFilter Field:=1, Criteria1:= _<br>                "<>" & <SPAN style="color:#00007F">CLng</SPAN>(DateValue(myDate))<br>            .Offset(1).EntireRow.Delete<br>            .AutoFilter<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">Else</SPAN><br>        MsgBox "No valid date entered"<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[shefer13]

HI Peter,

Thank you for that. Have run the test and is comes with the error 1004.

on the line wher it says
.Offset(1).Entirerow.Delete

Also I couldn't see where it says where the rows that will be copied, based on the search criteria, will be paste into.

Thanks again! You're a great help!

 

[shefer13]

HI Peter,

I thought maybe this macro will help. Its jusyt needs to tweaked to search for date not for number. Thanks

ub Copy_Row()
a = Application.InputBox("Enter date to find and copy")
With Sheets("All Channels").Range("A1:A10000")
Set c = .Find(a, LookIn:=xlValue, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Rows(Sheets("All Channels").Range(c.Address).Row).Select
For Each cell In Selection
'Insert values to exclude below in the place of 11111 and 22222
If cell.Value <> 13 / 9 / 2003 And cell.Value <> 99 / 99 / 9999 And cell.Value <> "" Then
If cell.Column = 1 Then
cell.Copy Destination:=Sheets("Sheet2").Cells(Application.CountA(Sheets("Sheet2").Range("A1:A50000")) + 1, cell.Column)
Else
cell.Copy Destination:=Sheets("Sheet2").Cells(Application.CountA(Sheets("Sheet2").Range("A1:A50000")), cell.Column)
End If
End If
Next
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Sheets("All Channels").Range("A1").Select
End Sub

 

[Peter_SSs]

HI Peter,

Thank you for that. Have run the test and is comes with the error 1004.

on the line wher it says
.Offset(1).Entirerow.Delete

Also I couldn't see where it says where the rows that will be copied, based on the search criteria, will be paste into.

Thanks again! You're a great help!

You didn't say what sheet the data had to go to so I thought it might be going to a brand new sheet.

If that is not what you want, please say what the destination sheet name is, whether it already contains data and, if so, whether the new data should replace the existing data or be appended to it.

For a start, try this version (still puts your rows in a new sheet) and see if it errors. If so, what are the answers to the following?

1. Is there more to that error message?

2. What version of Excel are you using?

3. Tell us more about the layout of your sheet.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> CopyDateRows()<br>    <SPAN style="color:#00007F">Dim</SPAN> myDate <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    myDate = InputBox("Enter Date")<br>    <SPAN style="color:#00007F">If</SPAN> IsDate(myDate) <SPAN style="color:#00007F">Then</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>        ActiveSheet.Copy After:=ActiveSheet<br>        <SPAN style="color:#00007F">With</SPAN> ActiveSheet<br>            lr = .Range("A" & .Rows.Count).End(xlUp).Row<br>            <SPAN style="color:#00007F">With</SPAN> .Range("A1:A" & lr)<br>                .AutoFilter Field:=1, Criteria1:= _<br>                    "<>" & <SPAN style="color:#00007F">CLng</SPAN>(DateValue(myDate))<br>                .Offset(1).EntireRow.Delete<br>                .AutoFilter<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">Else</SPAN><br>        MsgBox "No valid date entered"<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[shefer13]

Just run the test again. It has just created the full copy of entire spreadsheet and no search criteria was applied. I'm workin with 1997 Excel. The workbook contains two spreadsheets. one"All Channels" with the data and another "Weeklydata" that contains headings only. So I wanted to find rows contained specific date, copy them and paste into "Weeklydata" spreadsheet under the heading which in row3. In the other words to start the copy from A4.

Thanks

 

[Peter_SSs]

I'm workin with 1997 Excel.

I'm sorry, it is so long since I worked with Excel 97 that I cannot remember its features, so I'd only be guessing. Perhaps somebody else here still has a copy and can help.

 

[kapil_ajmera]

Sure, try this one.


Sub CopyDateRows()
Dim myDate As String

myDate = InputBox("Enter Date")
If IsDate(myDate) Then
Application.ScreenUpdating = False
ActiveSheet.Copy After:=ActiveSheet
With ActiveSheet.UsedRange.Columns(1)
.AutoFilter Field:=1, Criteria1:= _
"<>" & CLng(DateValue(myDate))
.Offset(1).EntireRow.Delete
.AutoFilter
End With
Application.ScreenUpdating = True
Else
MsgBox "No valid date entered"
End If
End Sub

I want from Sheet cash Macro Run and open search box and what I type the word in box it search the row and copy A,B,C,D,E to sheet1 only value and format not formula. Please help below is my sheet and password is welcome
Thanks in Advance

https://www.sendspace.com/file/7omh4c