Locking cells upon saving the file (VBA)

VitalyA

New Member
Joined
Mar 6, 2009
Messages
10
Hello dear Excel experts,

I need your help. I need to lock cells with new data entered by the user NOT immediately after the data has been entered but upon SAVING the file. All the VBA codes that I have been able to find on the web (like the one per this link: http://excel.tips.net/Pages/T002034_Automatically_Protecting_After_Input.html) are targeted to the first purpose, but I need to allow the user an opportunity to play around for a while with the data he enters - until he attempts to save the file.

Ideally, I would like my file to do the following:

1. Inform the user that he must take responsibility of accuracy of the data he enters because it will be locked for modification when he has saved the file. One "OK" button will be enough for this message.

2. Allow the user to enter the data and change it during the time the file is opened by him.

3. Display a message to the user with the same kind of information as above when he attempts to save the file (clicks the "Save" icon or closes the file and agrees to save changes). But in this case two buttons are required for the message: one would allow user to save the file and have the cells with new data locked, and the other would let him go back to the file and proceed with changing data.

I have prepared a sample file to play with but looks like I cannot attach it here.

Thank you very much in advance for your time and consideration!

VitalyA
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
You could do something with the thisworbook module

(right click the excel logo top left and view code)

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If MsgBox("Changes will be final and sheet will be locked, sure?", vbOKCancel, _
    "Warning") = vbCancel Then Exit Sub
    
    ActiveWorkbook.Protect
    
   
    
End Sub

Private Sub Workbook_Open()

MsgBox "Inform the user that he must take responsibility of accuracy of the data he enters because it will be locked for modification when he has saved the file", vbInformation, "Warning"
ActiveWorkbook.Unprotect
 
Upvote 0
Hi,

Maybe an on Save event like this may do the trick;

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim lRow As Long

x = MsgBox("Have you ensured that the data in Sheet ***** is accurate as the cells will not be editable after save", vbYesNo)

If x = 6 Then
    With Sheets("My Sheet")
        .Unprotect
        lRow = .Range("A" & Rows.count).End(xlUp).Row
        Rows("2:" & lRow).Locked
        .Protect
    End With
End If

End Sub

This will need to be pasted into the Workbook module within the VBE. To do so Right click on the Excel symbol on the menu bar at the top and hit View Code, then paste.
 
Upvote 0
Thank you very much gentlemen for your quick responses! Maybe I should have emphasized that I'm far from being an expert in Excel and VBA is a completely new animal for me, so it will require some time for me to understand how to correctly adjust your codes to my file.
 
Upvote 0
All you should need to do for my code is to put the required sheet name from your file where i have My Sheet.
 
Upvote 0
Mike,

I did exactly what you told me to, but Excel returnes an error message: Locked message of Range class failed. The thing is, I have a specific range in the file where users can enter their data (namely, ("F9:N60,Q9:V60,Y9:AB60,AE9:AH60,AK9:AN60"). Moreover, the file is protected by a password, so probably it should also be mentioned somehow in the code?... It is too difficult for me to explain everything in a message - if I could only send you the sample file...
 
Upvote 0
Mike,

now it doesn't return any error messages but it also doesn't lock the cells. The code is below:
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lRow As Long
x = MsgBox("Have you ensured that the data in Sheet Example is accurate as the cells will not be editable after save", vbYesNo)
If x = 6 Then
    With Sheets("Example")
        .Unprotect Password:="Fh[fyutkmcrbq"
        lRow = .Range("A" & Rows.Count).End(xlUp).Row
        Rows("2:" & lRow).Locked = True
        .Protect Password:="Fh[fyutkmcrbq"
    End With
 
End If
End Sub
 
Upvote 0
Hello all,

I seem to have have recieved the right solution; thank you Ronald! :) Posting it now here for future reference:

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If MsgBox("Changes will be final and sheet will be locked, sure?", vbOKCancel, _
    "Warning") = vbCancel Then Exit Sub
 
'change the sheetname "example" to your sheetname
Sheets("example").Select
 
ActiveSheet.Unprotect Password:="test"
'repeat this for all ranges you want to check
    For Each c In Range("F9:N60")
    If c.Value = "" Or c.Value = 0 Then
 
    Else
    c.Locked = True
 
    End If
 
    Next c
 'up to here end repeat
 
 'repeat this for all ranges you want to check
    For Each c In Range("Q9:V60")
    If c.Value = "" Or c.Value = 0 Then
 
    Else
    c.Locked = True
 
    End If
 
    Next c
 'up to here end repeat
 
 'repeat this for all ranges you want to check
    For Each c In Range("Y9:AB60")
    If c.Value = "" Or c.Value = 0 Then
 
    Else
    c.Locked = True
 
    End If
 
    Next c
 'up to here end repeat
 
 'repeat this for all ranges you want to check
    For Each c In Range("AE9:AH60")
    If c.Value = "" Or c.Value = 0 Then
 
    Else
    c.Locked = True
 
    End If
 
    Next c
 'up to here end repeat
 
 'repeat this for all ranges you want to check
    For Each c In Range("AK9:AN60")
    If c.Value = "" Or c.Value = 0 Then
 
    Else
    c.Locked = True
 
    End If
 
    Next c
 'up to here end repeat
 
 
  ActiveSheet.Protect Password:="test"
End Sub

Since I had a combined range of cells, I had to split it to simple ranges and repeat the IF condition for each simple range. This macro locks only non-blanks and different from zero cells upon saving the file.
 
Upvote 0

Forum statistics

Threads
1,203,078
Messages
6,053,404
Members
444,662
Latest member
AaronPMH

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top