Consulting

Results 1 to 5 of 5

Thread: 2016 Excel VBA Code for Locking a Cell after Data Entry

  1. #1
    VBAX Newbie
    Joined
    Sep 2017
    Posts
    5
    Location

    2016 Excel VBA Code for Locking a Cell after Data Entry

    I have made a macro for my spreadsheet that is supposed to conditional lock cells aft date is entered. I've tried running the macro but I get a debug notice at this lie cl.Locked = "True"

    This is the full macro: I am hoping someone can help me resolve the issue

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cl As Range
    ActiveSheet.Protect Password:="123"
    For Each cl In Target
    If cl.Value <> "" Then
    check = MsgBox("Is this entry correct? This cell cannot be edited after entering a value.", vbYesNo, "Cell Lock Notification")
    If check = vbYes Then
    cl.Locked = "True"
    Else
    cl.Value = ""
    End If
    End If
    Next cl
    Activeshet.Protect Password:="123"
    Last edited by Aussiebear; 05-13-2022 at 12:44 PM. Reason: Added code tags for supplied code

  2. #2
    VBAX Contributor rollis13's Avatar
    Joined
    Jun 2013
    Location
    Cordenons
    Posts
    100
    Location
    That's because you should begin with:
    ActiveSheet.Unprotect Password:="123"
    and end your macro with:
    ActiveSheet.Protect Password:="123"
    Instead you begin with .Protect and end with a typo.

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Posts
    8,295
    Location
    try this

    Also did a little formatting on the MsgBox

    Option Explicit
    
    
    'I assume that the entire WS is Locked = False
    
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cl As Range
        Dim check As VbMsgBoxResult
    
    
        For Each cl In Target
            With cl
                If Len(.Value) > 0 Then
                
                    check = MsgBox("Is this entry correct?" & vbCrLf & vbCrLf & _
                        vbTab & .Value & "  (" & .Address(False, False) & ")" & vbCrLf & vbCrLf & _
                        "This cell cannot be edited after entering a value.", vbYesNo, "Cell Lock Notification")
                    
                    If check = vbYes Then
                        If Me.ProtectContents Then Me.Unprotect Password:="123" '   unprotect first
                        .Locked = True
                        Me.Protect Password:="123" '   not Activeshet.
                    
                    Else
                        .ClearContents
                        ActiveCell.Offset(-1, 0).Select '   reselect data entry cell
                    End If
                End If
            End With
        Next cl
    
    
        
    End Sub
    Attached Images Attached Images
    Attached Files Attached Files
    Last edited by Paul_Hossler; 05-13-2022 at 07:56 PM.
    ---------------------------------------------------------------------------------------------------------------------

    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

  4. #4
    VBAX Newbie
    Joined
    Sep 2017
    Posts
    5
    Location
    Thanks for you for your help, what would I add if I needed to change a cell after data was entered into a cell and I selected yes, and then realized the data was incorrect? How would I unprotect the cell to make a chance, preferably using a short password? The work is being shared with a group of employees.

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Posts
    8,295
    Location
    Implemented via RightClick

    Could probably use some more error checking


    Option Explicit
    
    
    Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
        Dim rCell As Range
        Dim ans As VbMsgBoxResult
    
    
        For Each rCell In Target.Cells
            With rCell
                If Len(.Value) > 0 Then
                
                    ans = MsgBox("Do you want to reset this cell?" & vbCrLf & vbCrLf & _
                        vbTab & .Value & "  (" & .Address(False, False) & ")", vbYesNo, "Cell Lock Notification")
                    
                    If ans = vbYes Then
                        If ActiveSheet.ProtectContents Then ActiveSheet.Unprotect Password:="123" '   unprotect first
                        Application.EnableEvents = False
                        .ClearContents
                        .Locked = False
                        Application.EnableEvents = True
                        ActiveSheet.Protect Password:="123"
                    End If
                End If
            End With
        Next
            
        Cancel = True
        
    End Sub
    
    
    'I assume that the entire WS is Locked = False
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rCell As Range
        Dim ans As VbMsgBoxResult
    
    
        For Each rCell In Target
            With rCell
                If Len(.Value) > 0 Then
                
                    ans = MsgBox("Is this entry correct?" & vbCrLf & vbCrLf & _
                        vbTab & .Value & "  (" & .Address(False, False) & ")" & vbCrLf & vbCrLf & _
                        "This cell cannot be edited after entering a value.", vbYesNo, "Cell Lock Notification")
                    
                    If ans = vbYes Then
                        If Me.ProtectContents Then Me.Unprotect Password:="123" '   unprotect first
                        .Locked = True
                        Me.Protect Password:="123" '   not Activeshet.
                    
                    Else
                        .ClearContents
                        ActiveCell.Offset(-1, 0).Select '   reselect data entry cell
                    End If
                End If
            End With
        Next rCell
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    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

Tags for this Thread

Posting Permissions

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