Macro button to find today's date

If you need more info, or a copy of the spreadsheet, please let me know.

More info is always appreciable & work well for speedy response.. sample please..

Hi, Raef ,

why not use Conditional Formatting for highlighting the date?

=B3=TODAY()

And why not use only 3 cells for showing Today, Today - 51 as well as Today + 51? I donīt get the reason for requesting a macro.

Attach a sample workbook. Make sure there is just enough data to make it clear what is needed. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are demonstrated, mock them up manually if needed. Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

Ciao,
Holger

Hi, Raef,

can your Excel work with a picture and perform action in it? Mine canīt.

Sub FindToday_Values()
Dim rngFound As Range
Set rngFound = Range("B3:AP33").SpecialCells(xlCellTypeConstants, 23).Find(what:=Date, LookIn:=xlValues)
If Not rngFound Is Nothing Then
  Application.Goto reference:=Cells(3, rngFound.Column), Scroll:=True
End If
End Sub

Sub FindToday_Formulas()
Dim rngFound As Range
Set rngFound = Range("B3:AP33").SpecialCells(xlCellTypeFormulas, 23).Find(what:=Date, LookIn:=xlValues)
If Not rngFound Is Nothing Then
  Application.Goto reference:=Cells(3, rngFound.Column), Scroll:=True
End If
End Sub

Hi razor,

after click of button, where do you want to set focus..

As per your picture..
17 pixel Down.. and 245 pixel left.. or 2 inch Down form top, 3 inch left from left..

Hope you have already realised we cant setFocus on Picture.. and we cant attach Button in a picture.. without AdobeCS3..
Please upload .XLS[A-Z] file..

Hi, Raef,

Sub GoToDate()
Dim lngMonths As Long

lngMonths = Month(Date) - Month(Range("B3"))
If Year(Date) > Year(Range("B3")) Then
  lngMonths = lngMonths + 12
End If

Application.Goto Reference:=Cells(2, 2 + lngMonths * 3), Scroll:=True

End Sub

Corrected code:

Sub GoToDate2()
Dim lngMonths As Long

lngMonths = Month(Date) - Month(Range("B3"))
If lngMonths < 2 And Year(Date) > Year(Range("B3")) Then
  lngMonths = lngMonths + 12 * (Year(Date) - Year(Range("B3")))
End If

Application.Goto Reference:=Cells(2, 2 + lngMonths * 3), Scroll:=True

End Sub

Ciao,
Holger

Hi, Raef,

it works fine apart from the fact it selected June 18 and not May 18.

The code is supposed to find the column with the actual date, not any date in the past. Itīs not taking the date from any cell but from the system date of the computer. If you want it to reflect the date you put into Cell C35 please try

Sub Lapsedatefind_GivenDate()

Dim lngMonths As Long
Dim dteSearch As Date

dteSearch = Range("C35")

lngMonths = Month(dteSearch) - Month(Range("B3"))
If lngMonths < 2 And Year(dteSearch) > Year(Range("B3")) Then
  lngMonths = lngMonths + 12 * (Year(dteSearch) - Year(Range("B3")))
End If

Application.Goto Reference:=Cells(2, 2 + lngMonths * 3), Scroll:=True

End Sub

Please mind that you should wrap code with code-tags.

Ciao,
Holger

Hi, Raef,

if you search for the Lapse date you will have to face 2 months span in one column - maybe reduce it to search in the area which is 51 days ago like

Sub Lapsedatefind_GivenDate2()

Dim lngMonths As Long
Dim dteSearch As Date

dteSearch = Range("C35") - 51

If dteSearch <= Range("B3") Then Exit Sub


lngMonths = Month(dteSearch) - Month(Range("B3"))
If lngMonths < 2 And Year(dteSearch) > Year(Range("B3")) Then
  lngMonths = lngMonths + 12 * (Year(dteSearch) - Year(Range("B3")))
End If

Application.Goto Reference:=Cells(2, 2 + lngMonths * 3), Scroll:=True

End Sub

Ciao,
Holger

Hi, Raef,

thanks for the feedback. If this is what you have been looking for please mark this thread as Solved.

To mark your thread solved do the following:
- Go to the first post
- Click edit
- Click Advance
- Just below the word "Title:" you will see a dropdown with the word No prefix.
- Change to Solve
- Click Save

Ciao,
Holger