none
After data entry in specific cells these cells should be locked RRS feed

  • Question

  • Hi all.

    I am working on a "Quality Register" for a project. The idea is to set quality objectives for the project and then add "due dates", "approval dates" and "QA Result" (e.g. approved/not approved)

    I have made a table for the register (to allow sorting and pivot table statistics) and columns I, J, and K are for "due dates", "approval dates", and "QA Result", respectively.

    So far these three columns cover the cells I6:K72.

    I would like each cell to become locked when data is entered to the cell, while still having the rest of the table editable, i.e. columns A:H and L:O.

    So far I have this code (found here), but how do I make it specific to the above mentioned columns?

    Private Sub   Worksheet_Change(ByVal Target As Range)
          Dim cel As Range
          ActiveSheet.Unprotect ' Password:="quality"
          For Each cel In Target
              If cel.Value <> "" Then
                cel.Locked = True
              End If
          Next cel
          ActiveSheet.Protect ' Password:="quality"
    End Sub

    Thank you in advance.

    Thursday, October 2, 2014 7:07 AM

Answers

  • Change your code to this

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        
        If Intersect(Target, Range("I:K")) Is Nothing Then Exit Sub
        
        Me.Unprotect Password:="quality"
        For Each cel In Intersect(Target, Range("I:K"))
            If cel.Value <> "" Then
                cel.Locked = True
            End If
        Next cel
        Me.Protect Password:="quality"
    End Sub

    • Marked as answer by Mosbacher Thursday, October 9, 2014 1:52 PM
    Thursday, October 2, 2014 2:52 PM
  • Being picky here, but cel.Value may return a number. VBA usually manages conversion issues (it would convert the number to a string) but best test for an empty cell is:

    If Not Isempty(cel) Then

    I also find that every so often I need to work with sheets and edit locked cells, so to have them automatically locked can be a pain. I usually trust myself (risky, I know), so if the worksheet is already unprotected and the user name is mine, I exit. So I would end up with:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        
        'If worksheet already unprotected manually and login is me, don't lock cell
        If Target.Worksheet.ProtectContents = False And Application.UserName <> "MyUserName" Then
            If Not Intersect(Target, Range("I:K")) Is Nothing Then
                Me.Unprotect Password:="quality"
                For Each cel In Intersect(Target, Range("I:K"))
                    If Not IsEmpty(cel) <> "" Then
                        cel.Locked = True
                    End If
                Next cel
                Me.Protect Password:="quality"
            End If
        End If
    End Sub


    Rod Gill
    Author of the one and only Project VBA Book
    www.project-systems.co.nz

    • Marked as answer by Mosbacher Thursday, October 9, 2014 1:52 PM
    Thursday, October 2, 2014 7:58 PM

All replies

  • Change your code to this

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        
        If Intersect(Target, Range("I:K")) Is Nothing Then Exit Sub
        
        Me.Unprotect Password:="quality"
        For Each cel In Intersect(Target, Range("I:K"))
            If cel.Value <> "" Then
                cel.Locked = True
            End If
        Next cel
        Me.Protect Password:="quality"
    End Sub

    • Marked as answer by Mosbacher Thursday, October 9, 2014 1:52 PM
    Thursday, October 2, 2014 2:52 PM
  • Being picky here, but cel.Value may return a number. VBA usually manages conversion issues (it would convert the number to a string) but best test for an empty cell is:

    If Not Isempty(cel) Then

    I also find that every so often I need to work with sheets and edit locked cells, so to have them automatically locked can be a pain. I usually trust myself (risky, I know), so if the worksheet is already unprotected and the user name is mine, I exit. So I would end up with:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        
        'If worksheet already unprotected manually and login is me, don't lock cell
        If Target.Worksheet.ProtectContents = False And Application.UserName <> "MyUserName" Then
            If Not Intersect(Target, Range("I:K")) Is Nothing Then
                Me.Unprotect Password:="quality"
                For Each cel In Intersect(Target, Range("I:K"))
                    If Not IsEmpty(cel) <> "" Then
                        cel.Locked = True
                    End If
                Next cel
                Me.Protect Password:="quality"
            End If
        End If
    End Sub


    Rod Gill
    Author of the one and only Project VBA Book
    www.project-systems.co.nz

    • Marked as answer by Mosbacher Thursday, October 9, 2014 1:52 PM
    Thursday, October 2, 2014 7:58 PM
  • Thank you both! It works just as it should.

    Best regards,

    Rune Mosbacher

    Thursday, October 9, 2014 1:53 PM