Lookup Current Date and Find Next 5 enteries

[PGiessler]

Hi,

I am looking for a good way (something that works in 2007 & 2003) for find
the current date in a list of data and return that data plus the next 4
subsequent data points on a separate worksheet.


28-Apr-2009 Columbus
29-Apr-2009 Denver
5-May-2009 Canton
10-May-2009 Detroit
11-May-2009 Houston
11-May-2009 Dallas
20-May-2009 Boston

So, in the data set shown above ... I would just want the date and city data
in rows 2 through 6.

Any ideas would be greatly appreciated.

 

[JLGWhiz]

Assumes dates are in column A. The dates ib the sheet should be the same
format as the system date, which the Date constant uses.

Sub ject()
Dim lr As Long, srcRng As Range, c As Range
Dim newRng As Range
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set srcRng = Range("A2:A" & lr)
Set c = srcRng.Find(Date, LookIn:=xlValues)
If Not c Is Nothing Then
Set newRng = c.Resize(5, 2)
MsgBox newRng.Address
End If
End Sub

 

[JLGWhiz]

Or format Date to the same format that is in the column. Either way the
formats must be compatible or the code fails.

 

[JLGWhiz]

This uses your date format.

Sub ject()
Dim lr As Long, srcRng As Range, c As Range
Dim newRng As Range
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set srcRng = Range("A2:A" & lr)
Set c = srcRng.Find(Format(Date, "dd-mmm-yyyy"), LookIn:=xlValues)
If Not c Is Nothing Then
Set newRng = c.Resize(5, 2)
MsgBox newRng.Address
End If
End Sub

 

[PGiessler]

Thanks! This is perfect.

This uses your date format.

Sub ject()
Dim lr As Long, srcRng As Range, c As Range
Dim newRng As Range
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set srcRng = Range("A2:A" & lr)
Set c = srcRng.Find(Format(Date, "dd-mmm-yyyy"), LookIn:=xlValues)
If Not c Is Nothing Then
Set newRng = c.Resize(5, 2)
MsgBox newRng.Address
End If
End Sub