Lock ranges with password across multiple sheets-CodePudding

How would I password protect the same ranges across all the sheets in a workbook? For example I would like to lock down ranges H6:19 and E22:E29, across all existing sheets. I'm brand new to VBA and have been trying to look online most of today on how to do this. So far I came across this but it gives me a run-time error '1004' unable to set the locked property of the range class. Debugging points to "Selection.Locked = False"

Sub Protect_Range_Cells()
Dim range_1 As Range
Set range_1 = Range("h9:h16")
Cells.Select
Selection.Locked = False
range_1.Select
Selection.Locked = True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

End Sub

Does the tab need to be locked first? Is it possible to lock merged cells in the ranges?

Thanks!

CodePudding user response：

No selecting needed :)

Sub Protect_Range_Cells()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
       sh.Cells.Locked = False
       sh.Range("H9:H16,E22:E29").Locked = True
       sh.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
   Next
End Sub

If you have merged cells, the following should do the trick. Checking if cell is merged with MergeCell and locking entire area with MergeArea.locked

Sub Protect_Range_Cells()
    Dim sh As Worksheet
    Dim rng As Range
    For Each sh In ThisWorkbook.Worksheets
        sh.Cells.Locked = False
        For Each rng In sh.Range("H9:H16,E22:E29")
            'If rng.MergeCells Then ' not needed - see comments bellow
                rng.MergeArea.Locked = True
            'Else
                'rng.Locked = True
            'End If
        Next
        sh.Protect Password:="Your Password goes here", DrawingObjects:=False, Contents:=True, Scenarios:=False 'Thanks Ike
    Next
End Sub

Check @Ike's comment bellow for adding password protection and not just soft protection which can be undone with a simple click.

CodePudding user response：

Full credits goto @milo5m regarding the basic answer - but I would suggest a re-usable sub to lock ranges:

Sub protectAllWorksheets()
    Dim sh As Worksheet
    
    For Each sh In ThisWorkbook.Worksheets
        protectRange sh.Range("A1:D6,F1:F20"), "test"
    Next
End Sub


Public Sub protectRange(rgToProtect As Range, Optional pwd As String)

Dim sh As Worksheet, rng As Range
Set sh = rgToProtect.Parent

With sh
    sh.Unprotect pwd    'just in case it is already protected
    sh.UsedRange.Locked = False
               
    For Each rng In rgToProtect
        rng.MergeArea.Locked = True
    Next
    
    sh.Protect Password:=pwd, DrawingObjects:=False, Contents:=True, Scenarios:=False
End With

End Sub

Like this you are able to re-use the protectRange- sub for any range within your project - e.g. like this:

Sub protectWorksheets_Extended()

    Dim sh As Worksheet
    Dim rng As Range
    
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name Like "typeA_*" Then
            protectRange sh.Range("A1:D6,F1:F20"), "TypeAPwd"
            
        ElseIf sh.Name Like "typeB_*" Then 
            protectRange sh.Range("B2:X13"), "TypeBPwd"
        End If
    Next
    
    protectRange ThisWorkbook.Worksheets("Start").UsedRange, "overallpwd"
    
End Sub