Announcement

Collapse
No announcement yet.

Auto lock cells after data entered and SAVED.

Collapse
This topic is closed.
X
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Auto lock cells after data entered and SAVED.

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

    Code:
      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!
    Last edited by AAE; January 28th, 2012, 22:50. Reason: add code tags

  • #2
    Re: Auto lock cells after data entered and SAVED.

    Hi rosh22

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

    Code:
    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

    Comment


    • #3
      Re: Auto lock cells after data entered and SAVED.

      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.

      Code:
      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?
      Last edited by AAE; January 28th, 2012, 22:49. Reason: add code tags

      Comment


      • #4
        Re: Auto lock cells after data entered and SAVED.

        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.

        Comment


        • #5
          Re: Auto lock cells after data entered and SAVED.

          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

          Comment


          • #6
            Re: Auto lock cells after data entered and SAVED.

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

            Comment


            • #7
              Re: Auto lock cells after data entered and SAVED.

              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!

              Comment


              • #8
                Re: Auto lock cells after data entered and SAVED.

                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.
                Code:
                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
                Attached Files

                Comment


                • #9
                  Re: Auto lock cells after data entered and SAVED.

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

                  Thanks!

                  Comment


                  • #10
                    Re: Auto lock cells after data entered and SAVED.

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

                    Code:
                    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

                    Comment


                    • #11
                      Re: Auto lock cells after data entered and SAVED.

                      It works...but wow does it take a long time to save the file now.

                      Goes not responding for about 10 minutes.

                      Any solution?

                      Comment


                      • #12
                        Re: Auto lock cells after data entered and SAVED.

                        Is it possible it is targeting too many cells? Maybe if there wasa way to specify which cells to lock?

                        Comment


                        • #13
                          Re: Auto lock cells after data entered and SAVED.

                          it hardly takes 1 sec on my pc to save the workbook. no idea.. closing the workbook and reboot may help..

                          Comment


                          • #14
                            Re: Auto lock cells after data entered and SAVED.

                            I sent you the attachment without all my information filled in as well as the 5-6 pivot tables on different sheets.

                            Otherwise, its a 90mb file.

                            On the blank file w just the headings it takes about 1 sec. On my entire file it takes baout 5-6 minutes to save with the Macro, otherwise around 4 seconds without it.

                            Any other solutions?

                            I appreciate your help a lot.

                            Thanks so much for everything you have done so far!

                            Comment


                            • #15
                              Re: Auto lock cells after data entered and SAVED.

                              if the file is so big, then there is a little we can do to speed up the macro, by switching off the screenupdating and calculation, it can speed up a little.. try this -

                              Code:
                              Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
                                  StartTime = Time
                                  Application.Calculation = xlCalculationManual
                                  Application.ScreenUpdating = False
                                  Application.DisplayAlerts = False
                                  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
                                              i = Cell.Row
                                              j = Cell.Column
                                              If Cell.Value <> "" Then
                                                  If Cell.Locked = False Then
                                                  Cell.Locked = True
                                                  End If
                                              End If
                                          Next Cell
                                              Application.StatusBar = "Processing row " & i & " column " & j
                                          .Protect Password:=""
                                          'Protect with blank password, you can change it
                                  End With
                                  EndTime = Time
                                  TotalTime = Format(EndTime - StartTime, "hh:mm:ss")
                                  Application.Calculate
                                  Application.StatusBar = "Total Time Taken " & TotalTime
                                  Application.Calculation = xlCalculationAutomatic
                                  Application.DisplayAlerts = True
                                  Application.ScreenUpdating = True
                                  Application.StatusBar = False
                              End If
                              End Sub
                              Last edited by om_jul1983; January 20th, 2012, 21:02. Reason: Remove the Exit Sub

                              Comment

                              Working...
                              X