Thread: Date find Macro
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Paul C Paul C is offline
external usenet poster
 
Posts: 269
Default Date find Macro

The macro you show finds seven days prior to today, and you are now asking
for 7 days after and to switch to column A instead of Row 1.

The changes are relatively simple

Change MsgBox "This action will put the date to 7 days before today's date"
to MsgBox "This action will put the date to 7 after before today's
date"

Change Set rngRow1 = .Rows(1)
to Set rngRow1 = .Columns(1)

Change dateToday = Date - 7
to dateToday = Date +7

If you really want to be picky change all of the rngRow1 to rngCol1 so as
not to create confusion due to the name of the range, but this is not
necessary for the program to work, it just makes it easier to look at.

--
If this helps, please remember to click yes.


"Johnnyboy5" wrote:

I need a marco that when I click on the macro button it will jump to a
date in column A which is 7 days foward from the current date. This
is rather than scrolling all the way down the column to find the
current week. Someone did me one for the same task but then I was
using a row not a column.

thanks

Johnnyboy

Here is that macro (for row)

Macro1 Macro
' Macro recorded 08/08/2009 by john hayward
'
Sub Auto_open()
'Sub Auto_Open()
MsgBox "This action will put the date to 7 days before today's date"

Dim rngRow1 As Range
Dim rngToFind As Range
Dim dateToday As Date

'Edit Sheet1 to match your worksheet
Sheets("Planner").Select

With ActiveSheet
Set rngRow1 = .Rows(1)
End With

dateToday = Date - 7

With rngRow1
Set rngToFind = .Find(What:=dateToday, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
End With

If Not rngToFind Is Nothing Then
rngToFind.Select
ActiveWindow.ScrollRow = rngToFind.Row
ActiveWindow.ScrollColumn = rngToFind.Column
Else
MsgBox "Date " & dateToday & " not found. It might be the weekend.
Get a life !"
End If

End Sub
.