Find string/date, copy row to another sheet
Closed
Karlo
-
Aug 17, 2010 at 06:00 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Aug 23, 2010 at 09:59 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Aug 23, 2010 at 09:59 PM
Related:
- Excel vba copy row if cell value matches
- Number to words in excel without vba - Guide
- Enable vba in excel - Guide
- Vba case like - Guide
- Excel vba check if value exists in list - Guide
- Count if cell contains number - Excel Forum
7 responses
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Aug 17, 2010 at 10:36 PM
Aug 17, 2010 at 10:36 PM
I personally find it difficult to correct a long macro as I have to sync with the creator of the macro. I also presume there is only one date (that is today's date). in each sheet and there is no such date. also remember here today is 18 August
if there are more than one todays date the macro has to be mdofied.
do you think the following macro will get what you want?
===============
Sub test()
Dim j As Integer, k As Integer, cfind As Range, dest As Range
j = Worksheets.Count
For k = 1 To j
If Worksheets(k).Name = "Overall" Then GoTo nextk
'NAME OF SHEET SHOULD EXACT INCLUDING CASE
With Worksheets(k)
Set cfind = .Cells.Find(what:=CDate(Date), lookat:=xlWhole)
If cfind Is Nothing Then GoTo nextk
cfind.EntireRow.Copy
With Worksheets("Overall")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
nextk:
End With
Next k
End Sub
============================
if there are more than one todays date the macro has to be mdofied.
do you think the following macro will get what you want?
===============
Sub test()
Dim j As Integer, k As Integer, cfind As Range, dest As Range
j = Worksheets.Count
For k = 1 To j
If Worksheets(k).Name = "Overall" Then GoTo nextk
'NAME OF SHEET SHOULD EXACT INCLUDING CASE
With Worksheets(k)
Set cfind = .Cells.Find(what:=CDate(Date), lookat:=xlWhole)
If cfind Is Nothing Then GoTo nextk
cfind.EntireRow.Copy
With Worksheets("Overall")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
nextk:
End With
Next k
End Sub
============================
Hi venkat1926,
Thank you for your prompt reply.
I'm trying to create a macro wherein it asks the user to input a date. (created an InputBox for this)
It will then look for that date in all the succeeding sheets then copy the entire row from those sheets to the OverAll sheet.
The macro you inputted runs but you are right, the search has to be based on the date inputted on the InputBox and not just today's date.
Do you think you could modify the macro you inputted? It would greatly appreciated.
Thanks!
Karlo
Thank you for your prompt reply.
I'm trying to create a macro wherein it asks the user to input a date. (created an InputBox for this)
It will then look for that date in all the succeeding sheets then copy the entire row from those sheets to the OverAll sheet.
The macro you inputted runs but you are right, the search has to be based on the date inputted on the InputBox and not just today's date.
Do you think you could modify the macro you inputted? It would greatly appreciated.
Thanks!
Karlo
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Aug 18, 2010 at 09:41 PM
Aug 18, 2010 at 09:41 PM
try this macro
Sub test()
Dim j As Integer, k As Integer, cfind As Range, dest As Range
Dim d As Date
d = InputBox("type date you require in format mm/d/y")
j = Worksheets.Count
For k = 1 To j
If Worksheets(k).Name = "Overall" Then GoTo nextk
'NAME OF SHEET SHOULD EXACT INCLUDING CASE
With Worksheets(k)
Set cfind = .Cells.Find(what:=CDate(d), lookat:=xlWhole)
If cfind Is Nothing Then GoTo nextk
cfind.EntireRow.Copy
With Worksheets("Overall")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
nextk:
End With
Next k
End Sub
Hi venkat1926,
It works except it copies/pastes only the first item it captures on each succeeding worksheet.
Let's say if there were 4 succeeding worksheets with each sheet having about a dozen rows having the date e.g. 08/21/2010.
The macro would capture/paste only the first 08/21/2010 it sees on the first sheet, only the first 08/21/2010 it sees on the 2nd sheet, only the first 08/21/2010 on the 3rd sheet and so forth.
We need to capture/paste every row that has the date e.g. 08/21/2010 on each sheet, not just the first 08/21/2010 it sees on each sheet.
We've tried this macro -
Sub CopyOverAll()
Dim CurrentDate As Date
Dim j As Integer
Dim ws As Worksheet
Dim I As Double
Dim douTotal As Double
Dim cfind As Range
Dim dest As Range
CurrentDate = Date
CurrentDate = InputBox("Input Date as MM/DD/YYYY:")
' If Len(CurrentDate) = 0 Then Exit Sub
j = Worksheets.Count
For Each ws In Worksheets
I = 2
If ws.Name = "OverAll" Then
GoTo nextk:
Else
douTotal = Application.WorksheetFunction.CountA(ws.Range("A:A"))
Do While I < douTotal + 1
ws.Select
If Cells(i, 1) = CurrentDate Then
Rows(i).Copy
Sheets("OverAll").Select
Range("A" & Application.WorksheetFunction.CountA(Range("A:A")) + 3).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
I = I + 1
Loop
End If
nextk:
Next
End Sub
..and it works but it's too long. Is there anyway that yours can be tweaked to come up with the same result? Many thanks!
It works except it copies/pastes only the first item it captures on each succeeding worksheet.
Let's say if there were 4 succeeding worksheets with each sheet having about a dozen rows having the date e.g. 08/21/2010.
The macro would capture/paste only the first 08/21/2010 it sees on the first sheet, only the first 08/21/2010 it sees on the 2nd sheet, only the first 08/21/2010 on the 3rd sheet and so forth.
We need to capture/paste every row that has the date e.g. 08/21/2010 on each sheet, not just the first 08/21/2010 it sees on each sheet.
We've tried this macro -
Sub CopyOverAll()
Dim CurrentDate As Date
Dim j As Integer
Dim ws As Worksheet
Dim I As Double
Dim douTotal As Double
Dim cfind As Range
Dim dest As Range
CurrentDate = Date
CurrentDate = InputBox("Input Date as MM/DD/YYYY:")
' If Len(CurrentDate) = 0 Then Exit Sub
j = Worksheets.Count
For Each ws In Worksheets
I = 2
If ws.Name = "OverAll" Then
GoTo nextk:
Else
douTotal = Application.WorksheetFunction.CountA(ws.Range("A:A"))
Do While I < douTotal + 1
ws.Select
If Cells(i, 1) = CurrentDate Then
Rows(i).Copy
Sheets("OverAll").Select
Range("A" & Application.WorksheetFunction.CountA(Range("A:A")) + 3).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
I = I + 1
Loop
End If
nextk:
Next
End Sub
..and it works but it's too long. Is there anyway that yours can be tweaked to come up with the same result? Many thanks!
Didn't find the answer you are looking for?
Ask a question
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Aug 20, 2010 at 05:17 AM
Aug 20, 2010 at 05:17 AM
I indicated the need for modification. You can use eiher findnext code or autofitler.
try this macro and give your comments
TEH DATES ARE IN COLUMN A OF EACH OF THE SHEETS
try this macro and give your comments
TEH DATES ARE IN COLUMN A OF EACH OF THE SHEETS
Sub test()
Dim r As Range, rfilt As Range
Dim j As Integer, k As Integer, dest As Range
Dim d As Date
Worksheets("Overall").Cells.Clear
d = InputBox("type date you require in format mm/d/y")
j = Worksheets.Count
For k = 1 To j
If Worksheets(k).Name = "Overall" Then GoTo nextk
'NAME OF SHEET SHOULD EXACT INCLUDING CASE
With Worksheets(k)
Set r = .Range("A1").CurrentRegion
If WorksheetFunction.CountIf(r, d) = 0 Then GoTo nextk
r.AutoFilter field:=1, Criteria1:=d
Set rfilt = r.Offset(1, 0)
'msgbox rfilt.Address
rfilt.Cells.SpecialCells(xlCellTypeVisible).Copy
With Worksheets("Overall")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
r.AutoFilter
End With
nextk:
Next k
Worksheets("Ces").Range("A1").EntireRow.Copy
Worksheets("Overall").Range("A1").PasteSpecial
End Sub
Hi venkat1926,
The headers for each worksheet seem to get copied together with the filtered date/rows that are being copied.
When the rows are pasted to the OverAll summary sheet, the headers from the succeeding sheets get pasted as well.
Would there be a remedy for this?
Thanks!
Karlo
The headers for each worksheet seem to get copied together with the filtered date/rows that are being copied.
When the rows are pasted to the OverAll summary sheet, the headers from the succeeding sheets get pasted as well.
Would there be a remedy for this?
Thanks!
Karlo
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Aug 23, 2010 at 09:59 PM
Aug 23, 2010 at 09:59 PM
I do not know how your sheets are configured. do they have different headings for different sheets? I am sending my sample workbook. download from this web page and if possible and necessary modify the macro. If you still have problem post a very small extract of your file in speedyshare.com(as I have done) and explain once again with examples. The macro is in module in vb editor.
http://www.speedyshare.com/files/23938925/karlo2.xls
in the workbook you see sheet "overall" AFTER running the macro
"test"
if you want you can again run the macro and check.
http://www.speedyshare.com/files/23938925/karlo2.xls
in the workbook you see sheet "overall" AFTER running the macro
"test"
if you want you can again run the macro and check.
