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

0 votes

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?

Jan 14, 2023 in Others by Kithuzzz
• 38,020 points
560 views

1 answer to this question.

0 votes

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

answered Jan 14, 2023 by narikkadan
• 63,720 points

Related Questions In Others

0 votes
1 answer

Excel VBA- How to loop through specific sheets in a workbook and format the same ranges in each sheet

Range(...) instructs VBA to always use the ...READ MORE

answered Mar 21, 2023 in Others by Kithuzzz
• 38,020 points
1,673 views
0 votes
1 answer

How do I get the current date and time in PHP?

The time would go by your server ...READ MORE

answered Feb 16, 2022 in Others by Aditya
• 7,680 points
684 views
0 votes
1 answer
0 votes
1 answer

In excel how do I reference the current row but a specific column?

Put a $ symbol in front of ...READ MORE

answered Oct 15, 2022 in Others by narikkadan
• 63,720 points
1,842 views
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
1,112 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
3,545 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 23,260 points
830 views
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,690 points
988 views
0 votes
1 answer

How do I use the Indirect Function in Excel VBA to incorporate the equations in a VBA Macro Function

Try this: Sub Test() Dim str As String: str ...READ MORE

answered Jan 19, 2023 in Others by narikkadan
• 63,720 points
956 views
0 votes
1 answer

How Do I Correct a ByRef Mismatch Error in VBA for Worksheet_Change Sub in Excel?

Len of a string returns what you need. ...READ MORE

answered Apr 1, 2023 in Others by narikkadan
• 63,720 points
1,771 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP