Automatically protecting Sheets after saving

sumantskj

New Member
Joined
Aug 4, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hello I am trying to write macro which automatically locks cells after user has hit save button. The sheets is protected and contains some unlocked cells where user can input data in it. Now I want those cells to get locked after user has clicked data. I have multiple sheets in the workbook but I want this to happen just for first sheets.
I tried a lot code in the forum but without any luck, could any one help me with this one.


Code:

Option Explicit

Private bRangeEdited As Boolean
Private WithEvents ws As Worksheet


Private Sub Workbook_Open()
Set ws = Range("M12:U27").Parent
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String

sMSG = "saving the workbook will lock the cells you have entered data into." & vbLf
sMSG = sMSG & "Do you want to go ahead ?"
If Not bRangeEdited Then GoTo Xit
If Not Me.ReadOnly Then
With Range("M12:U27")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
.Parent.Unprotect "1234"
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
.Parent.Protect "1234"
End With
End If
Xit:
End Sub

Private Sub ws_Change(ByVal Target As Range)
If Not Intersect(Range("M12:U27"), Target) Is Nothing Then
bRangeEdited = True
End If
End Sub
 
Hi the sheets will be updated regularly. the sheets are protected initailly however editable cells remains unlocked . The cell remain empty, however when the user enters the data in the cell and when he clicks save button the cell should get locked. So after saving he is not allowed to edit the same cell unless he has the password for the protection. In the excel book, you can see the first column is locked while the rest is unlocked (but the sheet is in protection). So after he has enter data in Column B and clicked the save button, the cell should get locked and should be uneditable.
My code works fine when I have 1 sheet however it does not with multiple sheets.
Regards


TestVersion.xlsm
ABCDEFGHIJ
1Mindestanforderung an Q- & T- Blätter für die einzelnen Maschinengrößen
2
3Maschinentypen
4GK 0,30E
5GK 1,50E/N
6GK 4N
7GK 5E
8IM 20E
9IM 45E
10IM 90E
11IM 135E/T
12IM 190E
13IM 250E
14IM 255N
15IM 270E/N
16IM 320E
17IM 320VIC
18IM 400N
19IM 550E/ET
20IM 1000E/T
21
22
Tabel1
 
Upvote 0

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Ok, now it makes a little more sense, I think we were losing a little in translation. I’ll have a look at it tomorrow. Is this macro activated off of one sheet only or is it activated separately for each sheet.
 
Upvote 0
Here try this. It is untested, but should loop through each sheet locking the cells in each.
VBA Code:
Option Explicit

Private bRangeEdited As Boolean
Private WithEvents ws As Worksheet
Dim Wsh As Worksheet


Private Sub Workbook_Open()
    Set ws = Range("M12:U27").Parent
End Sub

Private Sub Worksheet_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String

sMSG = "saving the workbook will lock the cells you have entered data into." & vbLf
sMSG = sMSG & "Do you want to go ahead ?"
    If Not bRangeEdited Then GoTo Xit
    If Not Me.ReadOnly Then
    With Range("M12:U27")
        If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
        Cancel = True
        GoTo Xit
    End If
     For Each Wsh In ActiveWorkbook.Worksheets
        .Parent.Unprotect "1234"
        If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
        .SpecialCells(xlCellTypeConstants).Locked = True
        bRangeEdited = False
    Next
    End If
        .Parent.Protect "1234"
    End With
    End If

Xit:
End Sub

Private Sub ws_Change(ByVal Target As Range)
    If Not Intersect(Range("M12:U27"), Target) Is Nothing Then
        bRangeEdited = True
    End If
End Sub
 
Upvote 0
Ok, now it makes a little more sense, I think we were losing a little in translation. I’ll have a look at it tomorrow. Is this macro activated off of one sheet only or is it activated separately for each sheet.
Hey thanks for the reply. The macro is written in the MyWorkbook Module. So i guess it runs for the entire Workbook (I suppose all the sheets in the workbook).
Regards
 
Upvote 0
Here try this. It is untested, but should loop through each sheet locking the cells in each.
VBA Code:
Option Explicit

Private bRangeEdited As Boolean
Private WithEvents ws As Worksheet
Dim Wsh As Worksheet


Private Sub Workbook_Open()
    Set ws = Range("M12:U27").Parent
End Sub

Private Sub Worksheet_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String

sMSG = "saving the workbook will lock the cells you have entered data into." & vbLf
sMSG = sMSG & "Do you want to go ahead ?"
    If Not bRangeEdited Then GoTo Xit
    If Not Me.ReadOnly Then
    With Range("M12:U27")
        If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
        Cancel = True
        GoTo Xit
    End If
     For Each Wsh In ActiveWorkbook.Worksheets
        .Parent.Unprotect "1234"
        If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
        .SpecialCells(xlCellTypeConstants).Locked = True
        bRangeEdited = False
    Next
    End If
        .Parent.Protect "1234"
    End With
    End If

Xit:
End Sub

Private Sub ws_Change(ByVal Target As Range)
    If Not Intersect(Range("M12:U27"), Target) Is Nothing Then
        bRangeEdited = True
    End If
End Sub
Hello,
Tried your code. I believe Its the same code . Its not working.
Regards
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,205
Members
448,554
Latest member
Gleisner2

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