How do I run a VBA Sub routine continuously when working in a Workbook and not only when the Workbook is opened

Question

To check for a password and a predetermined expiration date, I created a subroutine. The code only functions after the Excel Workbook is opened. To demonstrate what I currently have, here is some code:

Private Sub Workbook_Open()

Dim j, i, trials, passCnt As Integer
trials = 3 'Number of trials
passCnt = 4 'Number of times to enter password
j = 1
ReDim AllPassWords(1 To trials) As String
AllPassWords(1) = "123"
AllPassWords(2) = "456"
AllPassWords(3) = "789"

ReDim ExpDate(1 To trials) As Date 'We pre-define the expiry dates and passwords
ExpDate(1) = CStr(DateSerial(2023, 1, 13) + TimeSerial(8, 49, 0))
ExpDate(2) = CStr(DateSerial(2023, 1, 13) + TimeSerial(8, 51, 0))
ExpDate(3) = CStr(DateSerial(2023, 1, 13) + TimeSerial(8, 53, 0))

Dim PassWord As String 'User password 

If CDate(Now) < ExpDate(j) Then 'If the jth trial has not expired we do the following

    If j = 1 Then
        For i = 1 To passCnt ' chances to enter password
            'Enter password before we can use the worksheet
            PassWord = InputBox("Please input password.")
            If PassWord = AllPassWords(j) Then
            
                Exit For
                
                ElseIf i < passCnt Then
                    MsgBox "Incorrect password. " & passCnt - i & " attempts remaining."
                
                ElseIf i = passCnt Then
                    MsgBox "Password limit reached. Closing workbook"
                    ThisWorkbook.Close
                
            End If
        Next i
    
    MsgBox ("You have " & ExpDate(j) - CDate(Now) & " days left")
        
    
    End If
    
    Else: MsgBox "Trial " & j & " has expired. New password will be required to continue"
        j = j + 1
End If

In order for the programme to prompt for a new password when the expiration date has passed, I need this sub to execute while the Workbook is open. The trial could simply be active as long as the user left the Workbook open. The'msgbox' appearing each time the code is run is the other issue I'm concerned about. Is it possible to execute the code while the Workbook is open while also preventing the msgbox display—apart from when the user opens the Workbook—from appearing on the screen?

Answer 1

on Thisworkbook, put:

Private Sub Workbook_Open()

Call checkPW(True)

End Sub

Then create two other macros in a separate module

Option Explicit

Sub checkPW(Optional firstRun As Boolean)

Dim j, i, trials, passCnt As Integer
trials = 3 'Number of trials
passCnt = 4 'Number of times to enter password
j = 1
ReDim AllPassWords(1 To trials) As String
AllPassWords(1) = "123"
AllPassWords(2) = "456"
AllPassWords(3) = "789"

ReDim ExpDate(1 To trials) As Date 'We pre-define the expiry dates and passwords
ExpDate(1) = CStr(DateSerial(2023, 1, 14) + TimeSerial(8, 49, 0))
ExpDate(2) = CStr(DateSerial(2023, 1, 15) + TimeSerial(8, 51, 0))
ExpDate(3) = CStr(DateSerial(2023, 1, 16) + TimeSerial(8, 53, 0))

Dim PassWord As String 'User password

If CDate(Now) < ExpDate(j) Then 'If the jth trial has not expired we do the following

    If j = 1 Then
        For i = 1 To passCnt ' chances to enter password
            'Enter password before we can use the worksheet
            PassWord = InputBox("Please input password.")
            If PassWord = AllPassWords(j) Then
            
                Exit For
                
                ElseIf i < passCnt Then
                    MsgBox "Incorrect password. " & passCnt - i & " attempts remaining."
                
                ElseIf i = passCnt Then
                    MsgBox "Password limit reached. Closing workbook"
                    ThisWorkbook.Close
                
            End If
        Next i
    
    MsgBox ("You have " & ExpDate(j) - CDate(Now) & " days left")
 
    End If

    Else:
    
    If firstRun = True Then
    MsgBox "Trial " & j & " has expired. New password will be required to continue"
    End If
        j = j + 1
End If

Call macro_timer

End Sub


Sub macro_timer()

'Tells Excel when to next run the macro.
Application.OnTime Now + TimeValue("00:00:10"), "checkPW"

End Sub

I used

    If firstRun = True Then
    MsgBox "Trial " & j & " has expired. New password will be required to continue"
    End If

To define what to show only when the workbook is opened, you can adjust as you need