Consulting

Results 1 to 9 of 9

Thread: VBA To Re-lock a specific cell after 30 seconds

  1. #1
    VBAX Mentor
    Joined
    Jan 2008
    Posts
    384
    Location

    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 ?

    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

  2. #2
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    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
    Last edited by Artik; 08-08-2019 at 02:56 PM.

  3. #3
    VBAX Mentor
    Joined
    Jan 2008
    Posts
    384
    Location
    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.

  4. #4
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    Quote Originally Posted by simora View Post
    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 View Post
    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 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:
    "'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
    Attached Files Attached Files

  5. #5
    VBAX Mentor
    Joined
    Jan 2008
    Posts
    384
    Location
    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.

  6. #6
    VBAX Mentor
    Joined
    Jan 2008
    Posts
    384
    Location
    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..

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    
    
    
    Attached Files Attached Files
    Last edited by Paul_Hossler; 08-10-2019 at 11:02 AM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  8. #8
    VBAX Mentor
    Joined
    Jan 2008
    Posts
    384
    Location
    Thanks Paul_Hossler:

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

    Thanks

  9. #9
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    Quote Originally Posted by Artik View Post
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •