PDA

View Full Version : Identifying rows of data which fall within a date range



lostin_space
08-02-2006, 06:15 AM
Hi all, i need to programmatically identify & isolate (copy to a new sheet)data (i.e. entire rows of data) in my worksheet which fall within specific date ranges (the dates are within 2 specific columns - start date / finish date)... is there an easy way to do this? solutions for it pre-done?

:dunno TIA

Russ

Bob Phillips
08-02-2006, 07:25 AM
Sub CopyData()
Const COL_START As Long = 2 '<== Change to suit
Const COL_END As Long = 4 '<== Change to suit
Const SH_TARGET As String = "Sheet3" '<== Change to suit
Dim iLastRow As Long
Dim rng As Range

iLastRow = Cells(Rows.Count, COL_START).End(xlUp).Row
Columns(1).Insert
Range("A1").Value = "Temp"
Range("A2").Resize(iLastRow - 1).FormulaR1C1 = "=AND(RC[2]>=start_date,RC[4]<=end_date)"
Set rng = Range("A1").Resize(iLastRow)
rng.AutoFilter Field:=1, Criteria1:="TRUE"
rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy Worksheets(SH_TARGET).Range("A1")
Columns(1).Delete
Worksheets(SH_TARGET).Columns(1).Delete
End Sub


this assumes that the test dates are in named ranges start_date and end_date

lostin_space
08-02-2006, 07:51 AM
Many thanks - that sort of works... but seems to copy some data that's outside of the range of dates i selected.... & also misses copying some of my other data also...

are there specific elements i should be watching?

lostin_space
08-02-2006, 08:30 AM
i've attached an example sheet of the data i'm working with, with a brief (better) explanation of what i'm trying to do.

Bob Phillips
08-02-2006, 08:58 AM
I perfectly understood what you wanted, but even though I dynamically identified the date columns, I didn't use them :doh:



Sub CopyData()

Const COL_START As Long = 12 '<== Change to suit
Const COL_END As Long = 13 '<== Change to suit
Const SH_TARGET As String = "Result" '<== Change to suit
Dim iLastRow As Long
Dim rng As Range

Application.ScreenUpdating = False

iLastRow = Cells(Rows.Count, COL_START).End(xlUp).Row

Columns(1).Insert

Range("A1").Value = "Temp"

Range("A2").Resize(iLastRow - 1).FormulaR1C1 = "=AND(RC" & COL_START + 1 & _
">=start_date,RC" & COL_END + 1 & "<=end_date)"

Set rng = Range("A1").Resize(iLastRow)
rng.AutoFilter Field:=1, Criteria1:="TRUE"
rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy Worksheets(SH_TARGET).Range("A1")
Columns(1).Delete
Worksheets(SH_TARGET).Columns(1).Delete

Application.ScreenUpdating = True

End Sub

lostin_space
08-14-2006, 06:26 AM
sorry, don't follow what you're saying - care to explain a bit further?