VBA To Re-lock a specific cell after 30 seconds

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 ?

Code:

---

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

---

In the worksheet module:

Code:

---

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):

Code:

---

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

Thanks Artik:

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

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.

Quote:

---

Originally Posted by simora

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. ;)

Quote:

---

Originally Posted by simora

Unfortunately, I got lost in the code logic.

---

Well then again.

Code:

---

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 Sub

---

Because 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:

Code:

---

"'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

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.

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..

Try this modified version

I added WS_Activate and changed the OnTime call

Code:

---

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




---

Code:

---

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




---

Thanks Paul_Hossler:

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

Thanks

Quote:

---

Originally Posted by Artik

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