0

I want the macro to run when the spreadsheet is opened the first time each day.

Multiple people will open the spreadsheet throughout the day and I don't want it running every time someone opens the file. It's currently set to run 1 minute after each time it's opened and that does work.

This is what I have:

In a Module:

Sub SingleLevelSort()

ActiveSheet.Unprotect Password:="VANS01"

Worksheets("Portfolio Tracker").Sort.SortFields.Clear
 
Range("A2:BA5000").Sort Key1:=Range("F3"), Header:=xlYes

ActiveSheet.Protect Password:="VANS01", AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, DrawingObjects:=True, Scenarios:=False, AllowDeletingRows:=True

Call Workbook_Open

End Sub

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:01:00"), "SingleLevelSort"
End Sub

In this WorkBook:

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:01:00"), "SingleLevelSort"
End Sub
Community
  • 1
  • 1
allthem
  • 25
  • 4
  • If the first person will open it before 09:00 then set a constraint that the macro does not run after 09:00. – Solar Mike Apr 21 '22 at 10:39
  • Or get the macro to set a file on the server to 1 and after that the macro checks that file and only runs if it is 0. Just reset that file at midnight... – Solar Mike Apr 21 '22 at 10:41
  • @SolarMike, thank you for coming back to me. Please note the spreadsheets are also kept on SharePoint. I don't know if this matters. I'm an absolute beginner at VBA's. How would I do this please: "Or get the macro to set a file on the server to 1 and after that the macro checks that file and only runs if it is 0. Just reset that file at midnight" – allthem Apr 21 '22 at 10:42
  • *when the spreadsheet is opened the first time each day* Use a helper cell in a hidden worksheet. You can put today date as start. Everytime the workbook is opened, if date equals to cell value, do nothing else do your code **and** update cell value with new date (so next time is opened it will do nothing) – Foxfire And Burns And Burns Apr 21 '22 at 10:54

3 Answers3

1

So, you can have a hidden sheet where every time the user opens the workbook, the code searches for 1 against today's date and if the both the conditions are satisfied, it will not run the code. In case, the given date is not today's date, it will overwrite the cell value with today's date.

You can use the below code but make sure to add today's date in Range("A1") and 1 in Range("B1")

Private Sub Workbook_Open()

Dim ws as worksheet

Set ws = Thisworkbook.Worksheet("Sheet1") ' add your hidden sheet name in place of sheet1

If Cells(1,1).value <> Date() then
ws.Cells(1,1).value = Date()
ws.Cells(1,2).value = "1"
Application.OnTime Now + TimeValue("00:01:00"), "SingleLevelSort"
Else
Exit  sub
End if
End Sub 

Let me know if you need any clarification with the code.

  • thank you for coming back to me and for writing the code, this is really helpful. The only problem I see with this is that a lot of people open the spreadsheet multiple times throughout the same day. This means the code will run each and every time as it will fit the variable. Ideally, I just want the code to run when the spreadsheet is opened the first time each day... – allthem Apr 21 '22 at 11:38
  • Only a small part of the code will run, i.e. to check if the date is today's date or not, if not then it will exit the sub. It won't hamper the performance of your sheet. Try it once :) – Sanjanajaggi Apr 21 '22 at 12:24
  • Unfortunately I can't for a number of reasons: 1. It's a large spreadsheet that has a lot of data on it so I can't risk it being corrupted by the macro 2. It has heavy traffic - again, I can't risk it being corrupted 3. I don't want someone to be adding a line and half way through it gets sorted in order because someone has opened the spreadsheet – allthem Apr 21 '22 at 12:59
  • So, this code will only work if the date is not same as today.. and if it is not the same as today, it will be amended, the first time sheet opens. So, this code will technically only run once the first time sheet is opened. You can test this on a sample data. It will help you understand the code better. – Sanjanajaggi Apr 22 '22 at 07:13
0

One solution is to add a Name to the Application.Names collection which can be tested upon the Workbook being opened.

Placed in ThisWorkbook

Private Sub Workbook_Open()
    Run "RunOnceDaily"
End Sub

Placed in a Module

Sub RunOnceDaily()
On Error GoTo ExitSub
    
    Dim LastDayRun As String
    Dim Today As String: Today = Replace(Trim(Date), "/", "") ' Date is an internal function
    
    For Each Item In Application.Names
        If Left(Item.Name, 10) = "LastRunDay" Then
            LastDayRun = Item.Name
            'Application.Names.Item(Item.Name).Delete  ' use to reset Workbook (comment loop block below out)
        End If
    Next
    If Right(LastDayRun, Len(Today)) <> Today Or LastDayRun = "" Then
        Call RunDaily
        Call Application.Names.Add("LastRunDay" & Today, RefersTo:=True, Visible:=False)
        If LastDayRun <> "" Then Application.Names.Item(LastDayRun).Delete
        Application.DisplayAlerts = False
            ThisWorkbook.Save
        Application.DisplayAlerts = True
    End If
    'Debug.Print "Macro Processed"

ExitSub:
End Sub

Private Function RunDaily()
    Debug.Print "Run Once Daily Completed"
End Function

You may want to move the Name addition and saving of the workbook to the RunDaily function so it only gets added once that macro has been fully completed (you could pass in the Today string for it)

Tragamor
  • 3,594
  • 3
  • 15
  • 32
0
Sub Workbook_Open()
    ' First, you want to get the utc
    ' regardless of user localization.
    ' https://stackoverflow.com/a/1600912/5332500
    
    Dim dt As Object, utc As Date
    Set dt = CreateObject("WbemScripting.SWbemDateTime")
    dt.SetVarDate Now
    utc = DateValue(dt.GetVarDate(False))
    
    ' Then check if the wb has been opened today
    If ThisWorkbook.Names("LastOpenedOn") = "=" & CLng(utc) Then
        Debug.Print "wb was opened."
    Else
        ThisWorkbook.Names("LastOpenedOn").RefersTo = utc
        Debug.Print "wb opened first time today."
        
        ' Finally you should save the workbook immediately
        ' after running the macro first time for the day.
        ThisWorkbook.Save
    End If
        
End Sub
Rosetta
  • 2,665
  • 1
  • 13
  • 29
  • Thank you Rosetta for this. I've amended my code in the ThisWorkBook part. When I tried to run it I get a Run-time error 1004 at this part: If ThisWorkbook.Names("LastOpenedOn") = "=" & CLng(utc) Then – allthem Apr 21 '22 at 14:41
  • Please can anyone help? – allthem Apr 21 '22 at 14:41
  • So my module section is still this: Sub SingleLevelSort() Worksheets("Portfolio Tracker").Unprotect Password:="VANS01" Worksheets("Portfolio Tracker").Sort.SortFields.Clear Range("A2:BA5000").Sort Key1:=Range("F3"), Header:=xlYes Worksheets("Portfolio Tracker").Protect Password:="VANS01", AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, DrawingObjects:=True, Scenarios:=False, AllowDeletingRows:=True Call Workbook_Open End Sub – allthem Apr 21 '22 at 14:42
  • This WorkBook section is this: Sub Workbook_Open() Dim dt As Object, utc As Date Set dt = CreateObject("WbemScripting.SWbemDateTime") dt.SetVarDate Now utc = DateValue(dt.GetVarDate(False)) ' Then check if the wb has been opened today If ThisWorkbook.Names("LastOpenedOn") = "=" & CLng(utc) Then Debug.Print "wb was opened." Else ThisWorkbook.Names("LastOpenedOn").RefersTo = utc Debug.Print "wb opened first time today." ThisWorkbook.Save End If End Sub – allthem Apr 21 '22 at 14:42
  • @allthem Just define a "Name" in Excel (see this https://support.microsoft.com/en-us/office/use-the-name-manager-in-excel-4d8c4c2b-9f7d-44e3-a3b4-9f61bd5c64e4) and call it `LastOpenedOn` – Rosetta Apr 22 '22 at 10:46