Auto lock cells after data entered and SAVED.

[rosh22]

Firstly, I know 0 about programming or VBA, but I found this code which auto locks cells after you enter data in them.

Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
     ' Place this code in the worksheet code module. ' The subroutine unprotects the sheet and IF an entry is made ' in an empty ("") cell, the cell is locked and then the ' sheet's protection is turned back on. Any further ' attempts to edit the cell generate the password msgbox. ' You can set the range to one cell ("A1") or an area ("A1:Z300"). ' 1. Use Format - Cells - Protection to unlock the cells ' in the range where one time entries are to be allowed. ' 2. Protect the worksheet with the same password as ' you use twice in the following subroutine (thepassword).
    On Error Goto justenditall 
    Application.EnableEvents = False If Not Intersect(Target, Range("A1:A20")) Is Nothing Then If Target.Value <> "" Then ActiveSheet.Unprotect Password:="thepassword" Target.Locked = True End If End If 
    ActiveSheet.Protect Password:="thepassword" 
    justenditall: Application.EnableEvents = True End Sub 

Now I want to make this only work when the file is saved. For example, when an employee opens up the file he or she is able to enter any new data, but not edit old data, and once saved, they will not be able to edit the data they just entered.
I hope this makes sense.
Thanks!

[om_jul1983]

Hi rosh22

you need to put this code in Workbook's beforesave event:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    Dim Cell As Range 
    With ActiveSheet 
        .Unprotect Password:="" 
        .Cells.Locked = False 
        For Each Cell In ActiveSheet.UsedRange 
            If Cell.Value = "" Then 
                Cell.Locked = False 
            Else 
                Cell.Locked = True 
            End If 
        Next Cell 
        .Protect Password:="" 
    End With 
End Sub 

[rosh22]

Thanks for the quick reply.

So I put this code in the workbook save event area, but when I arrive there, there is already this code there.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
     
End Sub 
 
Private Sub Workbook_Open() 
     
End Sub 

So where do I put it? Also, do I still need to put the original code in the worksheet area?

[om_jul1983]

Those are just junk lines which are automatically created whenever you go to workbook's event area.
When you go to BeforeSave event area of Workbook, delete all those lines which get auto generated and make your editor completely blank, then you can paste the above code which I posted.

[rosh22]

Thanks again for the quick reply.

So I left my original code in the worksheets VBA, and then entered your code in the workbook's event area, but I am still having the same problem. It is still auto locking after each entry, even before I press save.

Any ideas?

Thanks

[om_jul1983]

pls attach your workbook, (if this dosen't contain any sensitive data)

[rosh22]

My workbook.xlsMy workbook.xls

Ok

So you see the rows starting with date.

I need a system where once you fill up a cell, and save the file, you cannot edit the cell again, unless you have a password of course.

Thanks so much!

[om_jul1983]

Hi, please see the attachment. it's working perfect on my end. I have entered one row for testing and checked it's working fine.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    On Error Resume Next 
     'Resume to next line if any error occurs
    Dim Cell As Range 
    With ActiveSheet 
         'first of all unprotect the entire
         'sheet and unlock all cells
        .Unprotect Password:="" 
        .Cells.Locked = False 
         'Now search for non blank cells
         'and lock them and unlock blank cells
        For Each Cell In ActiveSheet.UsedRange 
            If Cell.Value = "" Then 
                Cell.Locked = False 
            Else 
                Cell.Locked = True 
            End If 
        Next Cell 
        .Protect Password:="" 
         'Protect with blank password, you can change it
    End With 
    Exit Sub 
End Sub 

[rosh22]

Thanks so much! One more question, is there a way to make this only apply to a certain sheet in my workbook?

Thanks!

[om_jul1983]

Try this, you can change sheet name as per your convenience

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
     
    If ActiveSheet.Name = "Sheet1" Then 
        On Error Resume Next 
         'Resume to next line if any error occurs
        Dim Cell As Range 
        With ActiveSheet 
             'first of all unprotect the entire
             'sheet and unlock all cells
            .Unprotect Password:="" 
            .Cells.Locked = False 
             'Now search for non blank cells
             'and lock them and unlock blank cells
            For Each Cell In ActiveSheet.UsedRange 
                If Cell.Value = "" Then 
                    Cell.Locked = False 
                Else 
                    Cell.Locked = True 
                End If 
            Next Cell 
            .Protect Password:="" 
             'Protect with blank password, you can change it
        End With 
        Exit Sub 
    End If 
End Sub