Create macro that automatically goes to current date from a monthly calendar on each tab when file is opened

KimC33

New Member
Joined
Aug 31, 2023
Messages
3
Office Version
  1. 365
Platform
  1. Windows
I am new to VBA. I have a spreadsheet where I created a calendar that has each month on separate tabs (named August, September, October, etc). I want the file to open and then automatically move the cursor to the current date, whatever tab that may be. I also wanted there to be a button that while working on the file, can be pressed and will bring them back to the tab with the current date.

1693505246133.png


I am using an Excel calendar template that has this formula in each of the numbered date fields. I will be continuing to add months to this template as we go along so each month with need to have these formulas so it has the current days of that month. I would rather not have to manually create each month if I don't have to. The formulas change each week but are the same each day within each week. They are as follows:

Excel Formula:
=DaysAndWeeks+DATE(CalendarYear,5,1)-WEEKDAY(DATE(CalendarYear,5,1),(WeekStart="Monday")+1)+1 
=DaysAndWeeks+DATE(CalendarYear,5,1)-WEEKDAY(DATE(CalendarYear,5,1),(WeekStart="Monday")+1)+8 
=DaysAndWeeks+DATE(CalendarYear,5,1)-WEEKDAY(DATE(CalendarYear,5,1),(WeekStart="Monday")+1)+15 
=DaysAndWeeks+DATE(CalendarYear,5,1)-WEEKDAY(DATE(CalendarYear,5,1),(WeekStart="Monday")+1)+22 
=DaysAndWeeks+DATE(CalendarYear,5,1)-WEEKDAY(DATE(CalendarYear,5,1),(WeekStart="Monday")+1)+29

Is it possible to create button and the overall macro when the file is opened to work with these formulas and not the typical date format? If so, how do you include that in the macro?

The button macro is as follows. However, I dont know how to make it generic so that when the current date is not in August, the button still works. I had to change the August in "Application.Goto Worksheets("August").Range("A1")" from Sheet 1 to get it to work initially.

VBA Code:
Sub CurrentDate_Click()

    Dim dateRng As Range
    Dim DateCell As Range
    Dim WorkSht As Worksheet
    Dim dateStr As String
    Application.Goto Worksheets("August").Range("A1")
    Application.ScreenUpdating = False
    For Each WorkSht In Worksheets
        WorkSht.Select
        'Set daterng = Range("A:A")
        Set dateRng = WorkSht.UsedRange
        'daterng.Select
        For Each DateCell In dateRng
            DateCell.Activate
            ActiveCell.Select
            On Error Resume Next
            dateStr = DateCell.Value
            If dateStr = Date Then
                DateCell.Select
                Exit Sub
            End If
        Next
    Next WorkSht
    Application.ScreenUpdating = True
    'Worksheets(1).Select
End Sub


Then I havent figured out how to do the overall macro when it opens it brings the user to the current date without having to press the button. I thought Private Sub Worksheet_Activate() might work, but keep getting errors when I tried to run the macro as written below.

VBA Code:
Private Sub Worksheet_Activate()

Sub CurrentDate_Click()

    Dim dateRng As Range
    Dim DateCell As Range
    Dim WorkSht As Worksheet
    Dim dateStr As String
    Application.Goto Worksheets("August").Range("A1")
    Application.ScreenUpdating = False
    For Each WorkSht In Worksheets
        WorkSht.Select
        'Set daterng = Range("A:A")
        Set dateRng = WorkSht.UsedRange
        'daterng.Select
        For Each DateCell In dateRng
            DateCell.Activate
            ActiveCell.Select
            On Error Resume Next
            dateStr = DateCell.Value
            If dateStr = Date Then
                DateCell.Select
                Exit Sub
            End If
        Next
    Next WorkSht
    Application.ScreenUpdating = True
    'Worksheets(1).Select
End Sub
End Sub



Anyway, I appreciate anyone's guidance on how to get the results I am aiming for, and I hope this all makes sense. Thanks!
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Code:
Private Sub Worksheet_Activate()
  sheets(format(date,"mmmm")).activate
end sub
 
Upvote 0
Code:
Private Sub Worksheet_Activate()
  sheets(format(date,"mmmm")).activate
end sub
I tried that and it does not work. I think because the cells are a formula not actual dates. Is there a way to tailer the sheets line to go with the formula instead of the mmmm date format?
 
Upvote 0
In case anyone else ever needs to do something similar, I found the solution on another site. It was to add Private Sub Workbook_Open() and the rest of the macro to the ThisWorkbook tab. I think that is why it didn't work in the first place. I was using the modules.

VBA Code:
Private Sub Workbook_Open()

    Dim dateRng As Range
    Dim DateCell As Range
    Dim WorkSht As Worksheet
    Dim dateStr As String
    Application.Goto Worksheets("September").Range("A1")
    Application.ScreenUpdating = False
    For Each WorkSht In Worksheets
        WorkSht.Select
        'Set daterng = Range("A:A")
        Set dateRng = WorkSht.UsedRange
        'daterng.Select
        For Each DateCell In dateRng
            DateCell.Activate
            ActiveCell.Select
            On Error Resume Next
            dateStr = DateCell.Value
            If dateStr = Date Then
                DateCell.Select
                Exit Sub
            End If
        Next
    Next WorkSht
    Application.ScreenUpdating = True
    'Worksheets(1).Select

End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,215,069
Messages
6,122,959
Members
449,096
Latest member
Anshu121

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top