none
lock Excel cell after value is entered RRS feed

  • Question

  • Hi there
    I am working on a excel sheet (excel 2010) what I wanted to do is once the user enter a value to the cell I wanted that cell to be lock with the value where no one can change the value.
    So e.g  cell A1 User enter value 100 once user move away from the cell the I want to lock the cell with the value in this case its A1
    How can I do this ?
    Wednesday, March 28, 2012 10:50 AM

Answers

  • Select all cells (press Ctrl+A, if that selects the current range only, press Ctrl+A again).

    Press Ctrl+1 to activate the Format Cells dialog, then activate the Protection tab. Clear the Locked check box, then click OK.

    Activate the Review tab of the ribbon. Click Protect Sheet. Tick or clear check boxes to determine what users are allowed to do, and ifd desired specify a password. Click OK.

    Right-click the sheet tab, and select View Code from the context menu. Enter the following code in the worksheet module:

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

    Save the workbook as a .xlsm, .xlsb or .xls workbook, not as a .xlsx workbook (those don't support macros).

    Regards, Hans Vogelaar

    • Marked as answer by Rushdy Najath Wednesday, March 28, 2012 11:38 AM
    Wednesday, March 28, 2012 11:33 AM

All replies

  • Select all cells (press Ctrl+A, if that selects the current range only, press Ctrl+A again).

    Press Ctrl+1 to activate the Format Cells dialog, then activate the Protection tab. Clear the Locked check box, then click OK.

    Activate the Review tab of the ribbon. Click Protect Sheet. Tick or clear check boxes to determine what users are allowed to do, and ifd desired specify a password. Click OK.

    Right-click the sheet tab, and select View Code from the context menu. Enter the following code in the worksheet module:

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

    Save the workbook as a .xlsm, .xlsb or .xls workbook, not as a .xlsx workbook (those don't support macros).

    Regards, Hans Vogelaar

    • Marked as answer by Rushdy Najath Wednesday, March 28, 2012 11:38 AM
    Wednesday, March 28, 2012 11:33 AM
  • Dear Hans,

    Thank you, the VBA code works however I want to aske you how to proteckt the VBA code from being visible?  Second question:  I protected the sheet after entering the VBA code and I also enteret a password but then it always asks me to unlock it when i put data in an empty cell!  I want it to aske me only if I want to change an entered value not when I put a value for the fist time!

    Thank you,,

    Monday, July 21, 2014 1:01 PM
  • 1) To protect the VBA code:

    • In the Visual Basic Editor, select Tools > VBAProject Properties...
    • Activate the Protection tab of the dialog that appears.
    • Tick the check box 'Lock project for viewing'.
    • Enter the password that you want to use in the 'Password' box, then enter the same password in the 'Confirm password' box.
    • Make sure that you remember this password!
    • Click OK.
    • Save and close the workbook.

    Next time you open the workbook, you'll have to provide the password if you want to view/edit the VBA code.

    2) You must unlock the cells before protecting the worksheet - see the beginning of my previous reply:

    • Select all cells (press Ctrl+A, if that selects the current range only, press Ctrl+A again).
    • Press Ctrl+1 to activate the Format Cells dialog, then activate the Protection tab. Clear the Locked check box, then click OK.

    If you omit these steps, the cells will be locked even if they are empty.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Monday, July 21, 2014 2:02 PM
  • Dear Hans, protection of the VBA code worked!  Thanks!

    My first problem still remains!  I do unlock all cells before protecting the sheet!  works fine if I don't put a password when protecting the sheet!  But if I protect the sheet and I also enter a password then when I enter data on any cell it first asks me to unlock the sheet!  This is only if I put a password!!! Don't know why?

    could send you a copy but can't do it from here!

    Thank you for you time!!!

    Wednesday, July 23, 2014 11:25 AM
  • If you wish, you can upload a copy of the workbook (without sensitive data) to OneDrive, DropBox or FileDropper. Make sure that you share the file and get a link to the shared file, then post the link in a reply here.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, July 23, 2014 11:30 AM
  • Ok! Here is the link "http://1drv.ms/WIy0DE"

    The code to view the VBA is "1"

    The data in the file are hypothetical!

    The sheet isn't protected with a code but if you put a code the pup up window comes and asks to unlock the sheet!

    Thanks a lot! 

    Vassilis

    Thursday, July 24, 2014 10:46 AM
  • If you protect the sheet with a password, you must also use that password in the code. I had indicated that in my first reply in this thread by including the password, but commented out.

    For example, if you protect the sheet with the password Athens, the code should be

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

    If you change the password, you'll have to change the code too.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, July 24, 2014 2:57 PM
  • Hans I tryied that, nothing changed!  Did you try that in the file I sent you?  Keeps aking for the password!!! :(

    Thursday, July 24, 2014 7:22 PM
  • Works for me! Here is a link to the modified workbook:

    http://1drv.ms/WLAfGm

    I set the password for the worksheet to Athens, and changed the code as in my previous reply.

    If it still doesn't work for you, could it be caused by your using Greek characters? VBA doesn't handle those well, I think. 


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, July 24, 2014 7:49 PM
  • Works!!!

    Thanks!  Don't know why I copied the code, and also protected the Sheet with Athens and worked!!!   Have done the same thing before and didn't???

    Seems to be ok now!!

    Thanks a lot for your time! 


    Thursday, July 24, 2014 9:00 PM
  • What about the fact that I have to enable macros in order for the code to work? Can this be dangerous, can I do it otherwise more safely?
    Friday, July 25, 2014 9:30 AM
  • There is no way to do this without VBA code, so you do need to enable macros.

    The easiest way to do this is to make the folder containing the workbook a trusted location for Excel.

    For Excel 2007, see http://office.microsoft.com/en-001/excel-help/create-remove-or-change-a-trusted-location-for-your-files-HA010031999.aspx

    For Excel 2010 and 2013, see http://office.microsoft.com/en-001/excel-help/add-remove-or-change-a-trusted-location-HA010354311.aspx


    Regards, Hans Vogelaar (http://www.eileenslounge.com)


    Friday, July 25, 2014 11:46 AM
  • Thanks, I hope my asking will stop sometime!  Now I have a new problem: the cells are locked after data entry and also protected with a code, good up to here but what happens if an employee for example chooses not to, or forgets to save the file?  Then the last enties even if locked will not be saved!  Can I prevent this from happening?
    Friday, July 25, 2014 12:55 PM
  • If the workbook is closed without saving it, the situation will be the same as before it was opened: empty cells will still be unlocked.

    You could force the workbook to be saved automatically when it's closed, but I'm not sure that that is desirable. Imagine the user has entered incorrect data by accident, and would like to start over by closing the workbook without saving it, then reopening it. If you save the changes automatically, that would be impossible.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, July 27, 2014 7:00 PM
  • Yes, this is what we want!  To be saved automatically!  If the user wants to correct an entry he/she can do it by entering a corrective entry!  But both the correct and the wrong one will be visible!  Just like you write on a paper!

    Monday, July 28, 2014 6:52 PM
  • You can do the following:

    Activate the Visual Basic Editor.

    Under 'Microsoft Excel Objects', double-click ThisWorkbook.

    Copy the following code into the ThisWorkbook module:

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
        If Me.Saved = False Then
            Me.Save
        End If
    End Sub

    This will save the workbook automatically if the user starts to close the workbook and if the workbook has been modified. The user won't get the usual question 'Do you want to save changes to ...?'.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Monday, July 28, 2014 6:58 PM
  • Great! Thanks!!!!
    Monday, July 28, 2014 7:45 PM
  • Dear Hans,

    I would like some help on how to use Conditional formating or a VBA formula to underline specific cells in a row if a value in entered in a specific colum.

    Thank you,

    Saturday, August 2, 2014 12:47 PM
  • I think that is a different question, so it would be better to start a new thread. In that thread, please provide more detailed information - "specific cells" and "specific column" is rather vague.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, August 2, 2014 12:51 PM
  • Ok!  Then more specific if a value is entered in cell A50 then underline row from A50 till Q50.

    Row 50 is an example!  I want this to apply from row 5 untill row 10.000

    Thanks,

    Saturday, August 2, 2014 1:26 PM
  • Please ask your question in a new thread - it has nothing to do anymore with the subject of this thread.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, August 2, 2014 1:51 PM
  • This is fantastic but is it possible to have the cells lock on save instead of on input?

    Wednesday, August 27, 2014 10:21 PM
  • Instead of using the Worksheet_Change event procedure in the module of the worksheet, create a Workbook_BeforeSave event procedure in the ThisWorkbook module.

    If you want to lock used cells in a specific worksheet only (Sheet1 in the following example):

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
        Dim rng1 As Range
        Dim rng2 As Range
        Dim rng As Range
        With Worksheets("Sheet1")
            With .Cells
                On Error Resume Next
                Set rng1 = .SpecialCells(xlCellTypeConstants)
                Set rng2 = .SpecialCells(xlCellTypeFormulas)
                On Error GoTo 0
                If Not rng1 Is Nothing Then
                    If Not rng2 Is Nothing Then
                        Set rng = Union(rng1, rng2)
                    Else
                        Set rng = rng1
                    End If
                ElseIf Not rng2 Is Nothing Then
                    Set rng = rng2
                Else
                    Exit Sub
                End If
            End With
            .Unprotect ' Password:="Secret"
            rng.Locked = True
            .Protect ' Password:="Secret"
        End With
    End Sub

    If you want to apply it to all worksheets:

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
        Dim wsh As Worksheet
        Dim rng1 As Range
        Dim rng2 As Range
        Dim rng As Range
        For Each wsh In Me.Worksheets
            Set rng = Nothing
            Set rng1 = Nothing
            Set rng2 = Nothing
            With wsh.Cells
                On Error Resume Next
                Set rng1 = .SpecialCells(xlCellTypeConstants)
                Set rng2 = .SpecialCells(xlCellTypeFormulas)
                On Error GoTo 0
                If Not rng1 Is Nothing Then
                    If Not rng2 Is Nothing Then
                        Set rng = Union(rng1, rng2)
                    Else
                        Set rng = rng1
                    End If
                ElseIf Not rng2 Is Nothing Then
                    Set rng = rng2
                End If
            End With
            If Not rng Is Nothing Then
                wsh.Unprotect ' Password:="Secret"
                rng.Locked = True
                wsh.Protect ' Password:="Secret"
            End If
        Next wsh
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, August 28, 2014 4:38 AM
  • hi there, I was wondering if you can help me.  Is there a way to merge this code with the one you have above?

    Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("A:A")) Is Nothing Then
    ActiveSheet.Unprotect Password:="123"
    Application.EnableEvents = False
        With Target.Offset(0, 1)
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm AM/PM"
        End With
    Application.EnableEvents = True
    ActiveSheet.Protect Password:="123"
    End If

    End Sub
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        ActiveSheet.Unprotect Password:="123"
        Target.Value = Now
        Target.Locked = True
        Target.Offset(0, 1).Select
        ActiveSheet.Protect Password:="123"
    End If

    End Sub

    Friday, September 5, 2014 9:17 PM
  • You could change the Worksheet_Change event procedure to

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("A:A")) Is Nothing Then
            ActiveSheet.Unprotect Password:="123"
            Application.EnableEvents = False
            With Intersect(Target, Range("A:A")).Offset(0, 1)
                .Value = Now
                .NumberFormat = "mm/dd/yyyy hh:mm AM/PM"
            End With
            Intersect(Target, Range("A:A")).Locked = True
            Application.EnableEvents = True
            ActiveSheet.Protect Password:="123"
        End If
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, September 5, 2014 9:40 PM
  • thank you so much for getting back to me.  I have just a couple more things if you could please help me.  This is the code I'm working with right now with your help...

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("A:A")) Is Nothing Then
            ActiveSheet.Unprotect Password:="123"
            Application.EnableEvents = False
            With Intersect(Target, Range("A:A")).Offset(0, 1)
                .Value = Now
                .NumberFormat = "mm/dd/yyyy hh:mm AM/PM"
            End With
            Intersect(Target, Range("A:A")).Locked = True
            Application.EnableEvents = True
            ActiveSheet.Protect Password:="123"
        End If
    End Sub
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        ActiveSheet.Unprotect Password:="123"
        Target.Value = Now
        Target.Locked = True
        Target.Offset(0, 1).Select
        ActiveSheet.Protect Password:="123"
    End If

    End Sub

    I also need column E to lock after a double click puts the time stamp in there.  and the last thing is, once this is protected and working right...i'll need to be able to add rows.  even checking the options when protecting the sheet, I still get an error when I try to add a row.  can this be avoided or, will I have to just periodically go in, unlock it to add a bunch of rows then lock it again?

    Wednesday, September 10, 2014 3:36 PM
  • Try this:

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Address = Target.EntireRow.Address Then Exit Sub
        If Not Intersect(Target, Range("A:A")) Is Nothing Then
            ActiveSheet.Unprotect Password:="123"
            Application.EnableEvents = False
            With Intersect(Target, Range("A:A")).Offset(0, 1)
                .Value = Now
                .NumberFormat = "mm/dd/yyyy hh:mm AM/PM"
            End With
            Intersect(Target, Range("A:A")).Locked = True
            Application.EnableEvents = True
            ActiveSheet.Protect Password:="123", AllowInsertingRows:=True
        End If
    End Sub
     
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        If Not Intersect(Target, Range("E:E")) Is Nothing Then
            ActiveSheet.Unprotect Password:="123"
            Target.Value = Now
            Target.Locked = True
            Target.Offset(0, 1).Select
            ActiveSheet.Protect Password:="123", AllowInsertingRows:=True
        End If
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, September 10, 2014 4:51 PM
  • It's not working in column E :(  is there anyway I can send you a sample of the spreadsheet I'm working on so you can see what I'm talking about?
    Wednesday, September 10, 2014 5:56 PM
  • Could you create a stripped-down copy of the workbook (without sensitive information) and make it available through one of the websites that let you upload and share a file, such as Microsoft OneDrive (https://onedrive.live.com), FileDropper (http://filedropper.com) or DropBox (http://www.dropbox.com). Then post a link to the uploaded and shared file here.

    Or register at www.eileenslounge.com (it's free) and post a message in the Excel forum. You can attach files up to 250 KB to a post there (zipped if necessary).


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, September 10, 2014 7:04 PM
  • I'm not sure I did it right, I'm so sorry, thank you for being so patient with me.  I went to onedrive and it's showing that and that I shared it...however, when I click on the linked chain in this window to give it to you, I don't see it showing up?  I'm so new to this :(  also, when I tried to send this response to you, it says it can not send a link before verifying my account?
    Wednesday, September 10, 2014 7:30 PM
  • ok, I just registered at eileenslounge.com, hopefully you can see it there? my user name is the same
    Wednesday, September 10, 2014 7:30 PM
  • Yes, I have seen your post there; I'm going to look at the workbook now.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, September 10, 2014 7:32 PM
  • See http://www.eileenslounge.com/viewtopic.php?f=27&t=17540

    This worked:

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        If Not Intersect(Target, Range("E:E")) Is Nothing Then
            If Target.Locked = False Then
                ActiveSheet.Unprotect Password:="123"
                Target.Value = Now
                Target.Locked = True
                Target.Offset(0, 1).Select
                ActiveSheet.Protect Password:="123", AllowInsertingRows:=True
            Else
                Beep
                Cancel = True
            End If
        End If
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, September 10, 2014 7:49 PM
  • I've been trying these codes but don't seem to get my spreadsheet to work as I hoped. I have 2 columns and would like to make column B5:B98 editable but once a value has been entered and the file saved the changed cell is then locked. Ideally, if someone else tries to edit an already filled cell they would get a message similar to "This cell has already been edited. Please use another". Is this possible using excel 2010? Any help would much appreciated!
    Wednesday, October 15, 2014 2:27 PM
  • When protecting the sheet, don't allow the user to select locked cells. That way, you don't even have to display a message.

    You could use a Worksheet_Change event like this:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        ActiveSheet.Unprotect ' Password:="secret"
            If Not Intersect(Range("B5:B98"), Target) Is Nothing Then
            For Each cel In Intersect(Range("B5:B98"), Target)
                If cel.Value <> "" Then
                    cel.Locked = True
                End If
            Next cel
        End If
        ActiveSheet.EnableSelection = xlUnlockedCells
        ActiveSheet.Protect ' Password:="secret"
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, October 15, 2014 4:19 PM
  • Tick or clear check boxes to determine what users are allowed to do, and ifd desired specify a password. Click OK.


    Regards, Hans Vogelaar

    Hello,

    i borrowed your code, as it was the neatest looking one i could possibly find when googling. however, when i run it excel responds by restraining users permission to delete rows, even though i ticked it in the checkbox before protecting the worksheet. i am dependent on the ability to delete rows, even if the data is protected by locked cells. do you have any thoughts on this?

    thank you so much in advance

    best regards
    Johannes Wahlstrøm

    Thursday, November 20, 2014 9:18 AM
  • A row that contains one or more locked cells cannot be deleted. If you want to be able to delete other rows, you must specify that in the code: change the line

        ActiveSheet.Protect ' Password:="secret"

    to

        ActiveSheet.Protect AllowDeletingRows:=True ' , Password:="secret"

    (If you want to protect the sheet with a password, remove the apostrophe ' and change the password as desired)


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, November 20, 2014 4:14 PM
  • Hi,

    please see below code incorporated into the sheet tab:

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        Dim rCell As Range
        Dim rChange As Range
        On Error GoTo ErrHandler
        Set rChange = Intersect(Target, Range("C:C"))
        If Not rChange Is Nothing Then
            Application.EnableEvents = False
            For Each rCell In rChange
                If rCell > "" Then
                    With rCell.Offset(0, 2)
                        .Value = Int(Now)
                    End With
                     With rCell.Offset(0, 1)
                        .Value = username
                    End With
                Else
                    rCell.Offset(0, 2).ClearContents
                    rCell.Offset(0, 1).ClearContents
                End If
            Next
        End If

        Set rChange = Intersect(Target, Range("C7"))
        If Not rChange Is Nothing Then
            Application.EnableEvents = False
            For Each rCell In rChange
                If rCell > "" Then
                    With rCell.Offset(-4, 1)
                        .Value = Int(Now)
                    End With
                Else
                    rCell.Offset(-4, 1).ClearContents
       
                End If
            Next
        End If

    ExitHandler:
        Set rCell = Nothing
        Set rChange = Nothing
        Application.EnableEvents = True
        Exit Sub
    ErrHandler:
        MsgBox Err.Description
        Resume ExitHandler
       
    End Sub

    Within the module I have this code:

    Function username()
    username = Environ("username")
    End Function

    I want to add a code to unlock and lock the cell range "D:E" after a value is entered in column "C" and unlock and lock it if i clear the value in column "C".

    Can you advise VBA code is needed?

    thanks,

    ed

    Monday, March 9, 2015 4:38 PM
  • Sorry, I don't understand. If you unlock and then lock a range of cells, nothing will have happened.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Monday, March 9, 2015 9:20 PM
  • Dear Hans! Below is the code I am using with your help:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        ActiveSheet.Unprotect Password:="321"
        For Each <g class="gr_ gr_57 gr-alert gr_spell ContextualSpelling" data-gr-id="57" id="57">cel</g> In Target
            If cel.Value <> "" Then
                cel.Locked = True
            End If
        Next <g class="gr_ gr_58 gr-alert gr_spell ContextualSpelling" data-gr-id="58" id="58">cel</g>
        ActiveSheet.Protect Password:="321"
    End Sub

    What I also want is every time a value is entered the document to be saved as well!

    Thank you,


    • Edited by VassilisTr Monday, May 11, 2015 10:05 AM
    Monday, May 11, 2015 10:02 AM
  • Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        ActiveSheet.Unprotect Password:="Athens"
        For Each <g class="gr_ gr_17 gr-alert gr_spell ContextualSpelling" data-gr-id="17" id="17">cel</g> In Target
            If cel.Value <> "" Then
                cel.Locked = True
            End If
        Next <g class="gr_ gr_18 gr-alert gr_spell ContextualSpelling" data-gr-id="18" id="18">cel</g>
        ActiveSheet.Protect Password:="Athens"
    End Sub

    Here is the code once more because it changed from alone!

    Monday, May 11, 2015 10:04 AM
  • Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        ActiveSheet.Unprotect Password:="321"
        For Each cel In Target
            If cel.Value <> "" Then
                cel.Locked = True
            End If
        Next cel
        ActiveSheet.Protect Password:="321"
    End Sub

    Monday, May 11, 2015 10:04 AM
  • You could add the following line just above End Sub:

        ActiveWorkbook.Save

    but keep in mind that saving the workbook at every change may have a negative effect on performance.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Proposed as answer by VassilisTr Friday, May 15, 2015 9:09 AM
    Monday, May 11, 2015 2:07 PM
  • Did this but the previus function which was locking cells after value was entered doesn't work now!!!

    ActiveSheet.Unprotect Password:="321"
        For Each cel In Target
            If cel.Value <> "" Then
                cel.Locked = True
            End If
        Next cel
        ActiveSheet.Protect Password:="321"

        ActiveWorkbook.Save
    End Sub

    • Proposed as answer by VassilisTr Friday, May 15, 2015 9:09 AM
    Tuesday, May 12, 2015 6:52 AM
  • Everything ok!  Wasn't working because I forgot to enable content!!!

    Thanks, everything works!!!




    • Edited by VassilisTr Friday, May 15, 2015 9:11 AM
    Tuesday, May 12, 2015 6:55 AM
  • can you please help me with my post - "

    Protect input after single cell entry within a range in MS Excel 2010"

    Thursday, August 27, 2015 11:56 AM
  • Dear Hans,

    I'm having an issue with the workbook.

    Basically, i want to apply this macro and ativate the shared workbook option in Excel 2010.

    Whenever i activate the shared workbook option, and i start to edit a specific cell, it popsup the error message Run-Time error '1004' :

    Unprotect method of Worksheet Class Failed.

    If i activate password, it gives me the following error:

    Application-defined or Object-defined Error

    Is there an option to overcome this issue?

    Is it possible to activate this macro on Shared Workbooks?


    Tuesday, November 10, 2015 7:17 PM
  • Sharing a workbook (except in Excel Online, but you can't use VBA there) is not a good idea - it leads to workbook corruption sooner or later.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Tuesday, November 10, 2015 7:51 PM
  •  DO YOU KNOW IF IT IS POSSIBLE TO CLEAR THE CONTENTS AFTERWARDS?

    FOR EXAMPLE I INPUTTED A VBA CODE TO LOCK THE CELLS AFTER ENTRY. BUT ONCE MY CELLS ARE FULL I PRINT IT AND WOULD LIKE TO CLEAR THE CONTENT AND RESUSE THE CELL- WHICH MEANS IT WILL START AS AN UNLOCKED CELL UNTIL DATA IS ENTERED THEN IT WILL LOCK. MY PROBLEM IS THAT EVEN WHEN I CLEAR THE CONTENTS, THE CELL IS PROTECTED SO I WOULD HAVE TO UNPROTECT EACH CELL ONE BY ONE EVERY TIME I WANT TO INPUT NEW DATA. AND WHEN I DELETE THE ENTIRE CELLS AND SHIFT THE CELLS UP, THAT SECTION IS STILL PROTECTED. HELP PLEASE?

    Wednesday, January 27, 2016 12:39 AM
  • Please don't use ALL CAPS - it's the internet equivalent of shouting loudly.

    You could use a macro to clear and unlock the cells:

    Sub ClearAndUnlock()
        ActiveSheet.Unprotect Password:="secret"
        With Range("C2:C10,E2:E10")
            .ClearContents
            .Locked = False
        End With
        ActiveSheet.Protect Password:="secret"
    End Sub

    Change the password and the range to suit your situation.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, January 27, 2016 6:49 AM
  • Hello! I am using this code to block the cells from one of my worksheets :

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        ActiveSheet.Unprotect ' Password:="1"
            If Not Intersect(Range("c:c"), Target) Is Nothing Then
            For Each cel In Intersect(Range("c:c"), Target)
                If cel.Value <> "" Then
                 cel.Locked = True
                 End If
            Next cel
        End If
        ActiveSheet.EnableSelection = xlUnlockedCells
         ActiveSheet.Protect AllowDeletingRows:=True ' , Password:="1"
    End Sub

    Now I need that some cells from range c:c to remain unprotected if on column d:d appears "Stress tests". Do you think it s possible to do something like this?

    Thank you in advance for your help,

    Regards, Cristian


    Friday, May 13, 2016 8:49 AM
  • Yes, like this:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        ActiveSheet.Unprotect ' Password:="1"
        If Not Intersect(Range("C:C"), Target) Is Nothing Then
            For Each cel In Intersect(Range("C:C"), Target)
                If cel.value <> "" And cel.Offset(0, 1).value <> "Stress tests" Then
                 cel.Locked = True
                 End If
            Next cel
        End If
        ActiveSheet.EnableSelection = xlUnlockedCells
        ActiveSheet.Protect AllowDeletingRows:=True ' , Password:="1"
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, May 13, 2016 11:32 AM
  • Thank you very much for your help! It's working perfectly!

    Best Regards,

    Cristian Toader


    Monday, May 16, 2016 10:22 AM
  • Thanks. The code worked as expected
    Tuesday, June 14, 2016 11:38 AM
  • Hi,

    If I only want to run it in column A, can you help me modify the formula?

    Wednesday, October 19, 2016 12:16 PM
  • I NEED TO UNLOCK CELLS FROM RANGE A16:C43 ONLY IF ANY VALUE IS ENTERD IN CELL k8
    Wednesday, February 22, 2017 1:28 PM
  • can we add one tab "send mail" and hwne we click this can we send this excel as attachment in mail..outlook
    Monday, February 27, 2017 9:08 AM
  • See http://www.rondebruin.nl/win/s1/outlook/mail.htm

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Monday, February 27, 2017 3:30 PM
  • Select all cells (press Ctrl+A, if that selects the current range only, press Ctrl+A again).

    Press Ctrl+1 to activate the Format Cells dialog, then activate the Protection tab. Clear the Locked check box, then click OK.

    Activate the Review tab of the ribbon. Click Protect Sheet. Tick or clear check boxes to determine what users are allowed to do, and ifd desired specify a password. Click OK.

    Right-click the sheet tab, and select View Code from the context menu. Enter the following code in the worksheet module:

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

    Save the workbook as a .xlsm, .xlsb or .xls workbook, not as a .xlsx workbook (those don't support macros).

    Regards, Hans Vogelaar


    Hi Hans

    Thank you for the code, it works great, but i have a bit of an issue.

    I have have a range, say A1:Z100 where some cells are blank but other already have data inserted. The it is now the code just locks all cells that have anything in them, but I would still like to keep some of those with data unlocked so that they can be edited later, and only to become locked after they actually have been modified. Next, would it be possible for it to lock the cells only when saving the file, not immediately after entering new values. It should give some flexibility to correct typos, etc.

    Thanks a lot !!
    Friday, March 17, 2017 9:11 AM
  • Instead of the Worksheet_Change event in the worksheet module, you could use the Workbook_BeforeSave event in the ThisWorkbook module:

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
        Dim cel As Range
        With Worksheets("MySheet") ' change name
            .Unprotect 'Password:="secret"
            For Each cel In Range("A1:Z100")
                Select Case cel.Address
                    Case "B5", "B10", "C5", "C10"
                        ' Leave these cells unaffected
                    Case Else
                        If cel.Value <> "" Then
                            cel.Locked = True
                        End If
                End Select
            .Protect 'Password:="secret"
        End With
    End Sub

    You can specify which cells you want to leave unlocked.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, March 17, 2017 11:25 AM
  • Thank you Hans

    I am sort of newbie in VBA coding. For the moment let us forget about cells that contain data and should not be locked, it is not that important. I understand this is the string that does that:

                Select Case cel.Address
                    Case "B5", "B10", "C5", "C10"
                        ' Leave these cells unaffected
                    Case Else

    As I understand, now I only copy this to ThisWorkbook module only and it will apply to the entire workbook. But I am working on several worksheets, and the range in each sheet is different. How to make the code work with those specific ranges, not one range for all sheets. And not for the entire sheets.

    In fact, I am working with a Table on each sheet. Those tables have their corresponding Names in the Name Manager (ex. Table_1, Table_2, Table_3, etc.). If that makes any difference, I would be prefer to have the locking only cells that were changed in those tables. There is one table per sheet.

    So I could use two options:

    1. Code to lock cells in different ranges on different sheets; or

    2. Code working only on the tables I am working with.

    Sorry I wasn't more explicit from the start. Wasn't expecting to have one Workbook code, thought I could just copy it to each sheet individually.

    Thanks again

    Friday, March 17, 2017 12:26 PM
  • If you want the code to run before the workbook is saved, you cannot place it in the worksheet modules of the individual sheets, it must be in the ThisWorkbook module.

    If you want the code to run when the user changes the value of a cell, you can use code in the worksheet modules.

    The choice is up to you.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, March 17, 2017 12:56 PM
  • Hello Hans, this thread is great and helping me quite a bit for same purpose of protecting data.

    However ,I am not seeing it locking cells after each save (i.e. data entered between two saves)

    I have gone through this thread completely to see what I may be missing but no success.

    I realize this thread is from 2014 but hope you can catch this message to help me understand the issue.

    Greatly appreciate your time and help here :)

    Friday, March 17, 2017 4:56 PM
  • Did you copy the code into the ThisWorkbook module? It will only work there.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, March 17, 2017 5:57 PM
  • Hans,

    The issue I have is that even though I enter a password to protect the sheet, it can be unprotected without having to use a password. Maybe I'm missing something, can you help?

    Friday, April 14, 2017 4:04 PM
  • I can't explain that, sorry.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, April 14, 2017 7:54 PM
  • Hi Hans!

    I am new to VBA coding and have tried inputting some of your recommendations above and the code is not working exactly how I'd like it to. What I want is for all empty cells to be unlocked and then lock once data is entered (upon save and close). I also have it set up for the workbook to automatically protect all worksheets upon save and close. When I enter data into blank cells, save and close, upon reopening those cells that I just entered data into are not locked. Here is the coding entered into my workbook. I'd like for this to be in "ThisWorkbook" to apply it to all worksheets. Before entering the code I unlocked all cells in the worksheet.


    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Update by Extendoffice 2018/1/24
        Dim xSheet As Worksheet
        Dim xPsw As String
        xPsw = "ahl"
        For Each xSheet In Worksheets
            xSheet.Protect xPsw
        Next
    End Sub


    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
        Dim wsh As Worksheet
        Dim rng1 As Range
        Dim rng2 As Range
        Dim rng As Range
        For Each wsh In Me.Worksheets
            Set rng = Nothing
            Set rng1 = Nothing
            Set rng2 = Nothing
            With wsh.Cells
                On Error Resume Next
                Set rng1 = .SpecialCells(xlCellTypeConstants)
                Set rng2 = .SpecialCells(xlCellTypeFormulas)
                On Error GoTo 0
                If Not rng1 Is Nothing Then
                    If Not rng2 Is Nothing Then
                        Set rng = Union(rng1, rng2)
                    Else
                        Set rng = rng1
                    End If
                ElseIf Not rng2 Is Nothing Then
                    Set rng = rng2
                End If
            End With
            If Not rng Is Nothing Then
                wsh.Unprotect ' Password:="ahl"
                rng.Locked = True
                wsh.Protect ' Password:="ahl"
            End If
        Next wsh
    End Sub

    Monday, September 30, 2019 5:19 PM
  • You cannot refer to SpecialCells on a protected sheet, so you must unprotect each sheet before doing that:

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
        Dim wsh As Worksheet
        Dim rng1 As Range
        Dim rng2 As Range
        Dim rng As Range
        For Each wsh In Me.Worksheets
            Set rng = Nothing
            Set rng1 = Nothing
            Set rng2 = Nothing
            wsh.Unprotect Password:="ahl"
            With wsh.Cells
                On Error Resume Next
                Set rng1 = .SpecialCells(xlCellTypeConstants)
                Set rng2 = .SpecialCells(xlCellTypeFormulas)
                On Error GoTo 0
                If Not rng1 Is Nothing Then
                    If Not rng2 Is Nothing Then
                        Set rng = Union(rng1, rng2)
                    Else
                        Set rng = rng1
                    End If
                ElseIf Not rng2 Is Nothing Then
                    Set rng = rng2
                End If
            End With
            If Not rng Is Nothing Then
                rng.Locked = True
            End If
            wsh.Protect Password:="ahl"
        Next wsh
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Monday, September 30, 2019 9:46 PM
  • Thanks Hans! That worked! Is there a way to make it not click through each worksheet in the workbook as it's saving and closing?
    Tuesday, October 1, 2019 3:55 PM
  • At the beginning of the macro, insert the line

        Application.ScreenUpdating = False

    and at the end, insert

        Application.ScreenUpdating = True


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Tuesday, October 1, 2019 7:29 PM
  • It's working beautifully! Thanks so much for your help, Hans!
    Tuesday, October 1, 2019 8:34 PM
  • You're welcome!

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Tuesday, October 1, 2019 8:44 PM