timed update window

wmtsub

Active Member
Joined
Jun 20, 2018
Messages
322
I have no idea if this is possible but would there be any way to run a macro to unprotect a worksheet for a given time limit like 3 min and then pop up a message asking if you would like an additional 3 minutes then if not protect the sheet again?

There are several ppl heere that accidently write over data not realizing thier focus is still on the spreadtsheet and not the document on thier other monito.
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Bump. I am looking for [if possible] a macro to un lock a sheet [got that] and after a specific period of time [ 1 min-2 min -3 min] automatically re-protect the worksheet. Any idea isf this is possible?
 
Upvote 0
I found the following code and thought if i changed
ActiveWorkbook.Save
to
ActiveWorkbook.protect "***"
it would work.
But it does not.
Any help would be appreciated.



Public RunWhen As Double
Public Const cRunIntervalSeconds = 300 ' this is 300 seconds or 5 Minutes
Public Const cRunWhat = "The_Sub"

Sub Auto_Open()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
End Sub


Sub The_Sub()'
ActiveWorkbook.Save

Auto_Open

End Sub
 
Upvote 0
.
Paste into routine module :

Code:
Option Explicit

Sub macro1()

'place your other code here
    MsgBox "Sheet is now unprotected. You have 5 seconds to complete changes.", vbInformation, "Sheet Unprotected "

    Application.OnTime Now + TimeValue("00:00:05"), "macro2"  '<-- this tells the macro, in 5 seconds run yourself again.

'place your other code here

End Sub

Sub macro2()
Dim Ans As Integer

    Ans = MsgBox("Continue working ? " & vbNewLine & vbNewLine & _
    "Press Yes/No", vbYesNo, "Sheet Protection ")
   
    If Ans = vbYes Then
        macro1
    Else
        
        MsgBox "Protecting sheet.", vbInformation, "Sheet protection"
        
        'Place password protection code here.
        
        Exit Sub
    End If
End Sub
 
Last edited:
Upvote 0
so I found an issue where if I change sheet focus before the macro completes it runs on the wrong sheet.
I tried this but did not work.
Anty solutions?

Sub Macro1()
'
' EdsUnProTkt
awsn = ActiveSheet.Name
Awsn.UnProTect "EDS"
Application.OnTime Now + TimeValue("00:00:05"), "Prtk2"
End Sub

Sub Prtk2()
Dim Ans As Integer
Sheet.awsn.Protect "EDS"
MsgBox ("Worksheet Now Protected")
End Sub
 
Upvote 0
.
I believe this will work :

Code:
Sub Macro1()
'
' EdsUnProTkt
awsn = ActiveSheet.Name		'<-- Change ActiveSheet.Name to Sheets("YourSheetNameHere")
Awsn.UnProTect "EDS"
Application.OnTime Now + TimeValue("00:00:05"), "Prtk2"
End Sub


Sub Prtk2()
Dim Ans As Integer		'<-- Delete this line
Sheet.awsn.Protect "EDS"	'<-- Change Sheet.awsn. to Sheets("YourSheetNameHere").Protect "EDS"
MsgBox ("Worksheet Now Protected")
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,212
Members
452,618
Latest member
Tam84

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