Finding rows with date between two given dates

Posted by dvlavianos on October 05, 2001 3:37 AM

I have a sheet that each row has the following format: data,data,DATE (dd/mm/yyyy),data. I want to make a macro that will find the rows that have DATE between 2 given dates(e.g. date1 and date2), and copy those rows to a different sheet. I am a newbie at Excel macro's and i'm having difficulty creating this macro on my own. Thanks in advance for your help.

Posted by Jerid on October 05, 2001 4:42 AM

Give this a try. It assumes that Date is in column C and sheet code names are sheet1 and sheet2

Sub MoveRows()
On Error GoTo ErrHandler

Dim dStartDate As Date
Dim dEndDate As Date

'Collect Start & End Dates
dStartDate = CDate(InputBox("Enter Start Date", "Valid Format - mm/dd/yyyy"))
dEndDate = CDate(InputBox("Enter End Date", "Valid Format - mm/dd/yyyy"))

'Find Dates Between Start Date & End Date and move to sheet 2
Sheet1.Activate

'Assume column C contains the dates
Application.Range("C1").Select

'Look at every row in column C until it finds an empty cell.
Do Until ActiveCell.Value = vbNullString

'Verify that the date is between the Start Date & End Date
If ActiveCell.Value > dStartDate And ActiveCell.Value &LT; dEndDate Then

'If it is, cut the entire row
ActiveCell.EntireRow.Cut

'Activate sheet 2
Sheet2.Activate

'Find the first blank row on sheet 2
Application.Range("A1").Select
Do Until ActiveCell.Value = vbNullString
ActiveCell.Offset(1, 0).Select
Loop

'Paste the row from sheet 1
ActiveSheet.Paste

'Return to sheet 1
Sheet1.Activate

'Delete the blank row
ActiveCell.EntireRow.Delete

'Move back down up row. The delete pushed us down one to many rows
ActiveCell.Offset(-1, 0).Select
End If

'Move down one row
ActiveCell.Offset(1, 0).Select
Loop

ExitHandler:
Exit Sub

ErrHandler:
Dim sMessage As String

sMessage = "An error has occured. This Macro will end"
sMessage = sMessage & vbCrLf
sMessage = sMessage & "Error Number - "
sMessage = sMessage & Err.Number
sMessage = sMessage & vbCrLf
sMessage = sMessage & "Error Description - "
sMessage = sMessage & Err.Description

MsgBox sMessage, vbCritical, "Macro Error"

Resume ExitHandler

End Sub

Hope this helps.

Jerid

Posted by dvlavianos on October 06, 2001 1:24 AM

Hallo Jerid. Thanks for your quick response in my mail. But i am afraid that i am doing something wrong because i get some error messages that i can't figure out what they mean. Can you send me an .xls file that contains same data and the macro you've send me, so that i can run the macro step by step and debug it so that i can see what the #$@!&* i am doing wrong? Maybe it has something to do with my settings. Anyway, i would like to thank you once again for the time you've spent in my request.

PS. You can send the file to dvlavianos@cosmote.gr

'Collect Start & End Dates dStartDate = CDate(InputBox("Enter Start Date", "Valid Format - mm/dd/yyyy")) dEndDate = CDate(InputBox("Enter End Date", "Valid Format - mm/dd/yyyy"))