Macro Protection in all Worksheets but only for cells with some value

Question

i need some help to make my code work. My code is pretty simple. It goes through all my worksheets and make simple check in Columns A:D. If one cell has some text it will be locked. All free cells will stay for users unlocked.

It starts with other macros from my worksheet with Workbook_Open as Call command.

I used it all the time in each Worksheet separatly, but it won't work with new sheets so i decided to make it somehow global and dynamic for old sheets and new added sheets.

Old code:

Public Sub auo_open()

Dim strPassword As String
strPassword = "Athens"

With Tabelle1
    .Unprotect Password:=strPassword
    .Cells.Locked = True

    On Error Resume Next
    .Range("A:D").SpecialCells(xlCellTypeBlanks).Locked = False
    On Error GoTo 0
    .Protect Password:=strPassword, UserInterfaceOnly:=True, AllowFormattingCells:=True, AllowInsertingRows:=True

End With
Exit Sub

As you see it wasn't that good i had to put for each sheet a call command

new Code:

Public Sub Protection()
 Dim ws As Worksheet
 Dim strPassword As String
 strPassword = "Athens"


For Each ws In ThisWorkbook.Worksheets

    ws.Unprotect Password:=strPassword
    ws.Cells.Locked = True

    On Error Resume Next
    ws.Range("A:D").SpecialCells(xlCellTypeBlanks).Locked = False
    On Error GoTo 0
    ws.Protect Password:=strPassword, UserInterfaceOnly:=True, AllowFormattingCells:=True, AllowInsertingRows:=True
Next ws
End Sub

Have a look at how I protect sheets: stackoverflow.com/a/51661932/4961700 -it may help... — Solar Mike
No need to loop. Use the Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) to lock the cell — Siddharth Rout

Siddharth Rout Siddharth Rout · Accepted Answer · 2018-08-04T19:34:40

Further to my comment above, try something like this. This code will automatically be applicable to the newly added worksheets

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim strPassword As String: strPassword = "Athens"
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns("A:D")) Is Nothing Then
        With Sh
            .Unprotect strPassword
            Cells.Locked = True
            Range("A:D").SpecialCells(xlCellTypeBlanks).Locked = False
            .Protect strPassword
        End With
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Screenshots

Put the code in the ThisWorkbook code area.

Macro Protection in all Worksheets but only for cells with some value

1 Answers