PDA

View Full Version : [SOLVED] VBA To Re-lock a specific cell after 30 seconds



simora
08-08-2019, 01:18 PM
I am Unlocking a cell, but I need to automatically Re-Lock that cell after 30 seconds;
I also need to be able to change other cells after I unlock my cell during that 30 second window.
This code Unlocks the cell. How do I re-Lock it after the desired time while still having access to my worksheet ?



Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Me.Range("J2:J65536")) Is Nothing Then
If Target.Value > 0 Then
Target.Offset(0, 3).Locked = False
End If
End If

Artik
08-08-2019, 02:00 PM
In the worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rngM As Range
Dim rngScope As Range
Dim boolUnlock As Boolean

Set rngScope = Intersect(Target, Me.Range("J2:J" & Rows.Count))

If Not rngScope Is Nothing Then
Me.Unprotect Password:=g_strPASS

For Each rngM In rngScope
If Not IsError(rngM.Value) Then
If rngM.Value > 0 Then

Set rng = rngM.Offset(0, 3)

rng.Locked = False
boolUnlock = True
End If
End If
Next rngM

Me.Protect Password:=g_strPASS

If boolUnlock Then
Application.OnTime Now + TimeSerial(0, 0, 10), "'LockRange """ & rngScope.Offset(0, 3).Address(External:=True) & """'"
End If

End If
End Sub
and in STANDARD module (eg. Module1):
Option Explicit

Public Const g_strPASS As String = "My Password or Empty"


Sub LockRange(strAddress As String)
With Application.Range(strAddress)
.Parent.Unprotect Password:=g_strPASS
.Locked = True
.Parent.Protect Password:=g_strPASS
End With
End Sub

Artik

simora
08-09-2019, 03:43 PM
Thanks Artik:

I think that We've got an error in this area of the code.


If boolUnlock Then
Application.OnTime Now + TimeSerial(0, 0, 10), "'LockRange """ & rngScope.Offset(0, 3).Address(External:=True) & """'"
End If


It keeps telling me that it can't run the Macro LockRange, because it might be unavailable etc...etc... The idea was not to allow anyone to enter anything in Column M until something was entered into column J. That would unlock the Cell on that row in Column M but only for 30 seconds.

Thanks for the effort. Unfortunately, I got lost in the code logic.

Artik
08-09-2019, 06:51 PM
It keeps telling me that it can't run the Macro LockRange, because it might be unavailable etc...etc...You had to screw up something. ;)



Unfortunately, I got lost in the code logic.Well then again.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rngM As Range
Dim rngScope As Range
Dim boolUnlock As Boolean

1 Set rngScope = Intersect(Target, Me.Range("J2:J" & Rows.Count))

If Not rngScope Is Nothing Then
Me.Unprotect Password:=g_strPASS

2 For Each rngM In rngScope
3 If Not IsError(rngM.Value) Then
If rngM.Value > 0 Then

4 Set rng = rngM.Offset(0, 3)

5 rng.Locked = False
6 boolUnlock = True
End If
End If
Next rngM

Me.Protect Password:=g_strPASS

7 If boolUnlock Then
8 Application.OnTime Now + TimeSerial(0, 0, 10), "'LockRange """ & rngScope.Offset(0, 3).Address(External:=True) & """'"
End If

End If
End SubBecause the user can enter multiple values at the same time in the J column (e.g. Ctrl + V or Ctrl + Enter when several cells are selected), therefore use the For Each ... Next loop.
1. Determine the common part of column J and the range in which the value was entered. If something is entered in another column, the procedure will end.
2. Loop over the range rngScope cells.
3. First, check that the cell being tested does not contain a sheet error. People can type a different things. A spreadsheet error does not have to be the result of a formula. If you did not apply this condition, and immediately check if the value is greater than 0, then there would be a runtime error with the sheet error value.
4. Create a cell reference in column M.
5. Unlock the cell in column M.
6. Set the boolUnlock flag to True when at least one cell in the rngScope range is greater than 0.
7. When the flag is True ...
8. Call OnTime event for NN seconds. The first parameter is the time when the macro is to be run, the second parameter is the name of the macro to be run. MS in the help says nothing that we can pass arguments to the macro called. This is where I show how to do it. The text string must begin and end with an apostrophe. Arguments must be separated by commas.Text arguments must be enclosed by additional quotation marks.
Examples of the second OnTime event parameter:

"'MyMacro1 1.234, 3'"
"'MyMacro2 ""Wow :-)""'"
"'MyMacro3 1.234, ""Wow :-)"", 3'"
To the LockRange procedure we pass the address of the rngScope range shifted by 3 columns (i.e. the address of the cells in the M column). Additionally, in the Address property we add the parameter External: = True. This ensures that the LockRange procedure will "know" which sheet to unlock, lock the cells and lock sheet again.


I attach a workbook that works for me.


Artik

simora
08-09-2019, 07:11 PM
Artik:

I suspect that the problem is with my version of Excel 2007, or the 64Bit Vista operating system,
because I saved the workbook and I got the same error as before.
I will try to test it on Tuesday sometime on another system.
Again, thanks for your help on this.

simora
08-09-2019, 11:10 PM
Artik:
I just tried it using Office 2007 & win 8.1 and the same problem.
It says the same error. Cannot run Macro LockRange, because it might be unavailable etc...etc..

Paul_Hossler
08-10-2019, 08:05 AM
Try this modified version

I added WS_Activate and changed the OnTime call




Option Explicit

Const iWait As Long = 10 'testing

Private Sub Worksheet_Activate()

bInCountDown = False

With Me
.Unprotect Password:=g_strPASS
.Columns(10).Locked = False
.Columns(13).Locked = True
.Cells(1, 10).Locked = True
.Protect Password:=g_strPASS
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rngM As Range
Dim rngScope As Range
Dim boolUnlock As Boolean
Set rngScope = Intersect(Target, Me.Columns(10))
If rngScope Is Nothing Then Exit Sub
If bInCountDown Then Exit Sub

Me.Unprotect Password:=g_strPASS
Set rng = rngScope.Offset(0, 3)
rng.Locked = False
Me.Protect Password:=g_strPASS
Application.StatusBar = "Now Unlocking column M for " & iWait & " seconds"
bInCountDown = True
Application.OnTime Now + TimeSerial(0, 0, iWait), "'LockRange """ & Me.Name & "!" & rngScope.Offset(0, 3).Address & """'"
End Sub










Option Explicit

Public Const g_strPASS As String = "aaa"
Public bInCountDown As Boolean

Sub LockRange(strAddress As String)
Application.StatusBar = "Now Relocking " & strAddress
Application.EnableEvents = False

With Application.Range(strAddress)
.Parent.Unprotect Password:=g_strPASS
.Locked = True
.Parent.Protect Password:=g_strPASS
End With

Application.EnableEvents = True
bInCountDown = False
Application.StatusBar = False
End Sub

simora
08-11-2019, 01:54 PM
Thanks Paul_Hossler:

It worked as both a xlsm and a xls file. No Problems.

Thanks

Artik
08-11-2019, 03:28 PM
You had to screw up something. ;)Sorry, it seems that Microsoft screwed up. But then it improved because it works for me (MSO 365). The error probably only occurs in the 2007 version, which unfortunately contains many other bugs.

I want to point out that the presets contained in the WS_Activate procedure will not be invoked in two cases:
a) the workbook contains only one sheet,
b) when a workbook is opened, where the programmed worksheet is active.

In addition, turning events off and on in procedure LockRange is redundant. Neither unlocking the sheet or blocking cells does not trigger programmed events.

But most importantly, that the problem was solved. :)

Artik