Macro for protecting / unprotecting worksheets

Zakkala · Nov 16, 2005

Hi there,

Wonder if you could help. I have a workbook with a large number of worksheets all protected with the same password, to stop formula being overtyped.

As it is time consuming to unprotect them one by one for alterations, I was wondering if there is some code that I could use for a macro that will unprotect them all? An then, presumably, very similar code that will re-protect them again!

Thanks for your time.

hatman · Nov 16, 2005

Try this code:

Code:

Sub Hide_Prot()
'
' Macro1 Macro
' Macro recorded 9/27/2005 by Paul Sasur
'

'
    Dim mb As VbMsgBoxResult
    Dim xcol As Integer
    
    On Error GoTo BuildRange
    
    xdata = Range("Hide_Protect")
    
    row_tot = UBound(xdata, 1)
    
    cnt_1 = 0
    cnt_2 = 0
    
    For cnt = 1 To row_tot
    
        If xdata(cnt, 2) <> "" Then
        
            cnt_2 = cnt_2 + 1
            
            If Worksheets(xdata(cnt, 1)).Visible = False Then
            
                cnt_1 = cnt_1 + 1
                
            End If
            
        End If
        
        If xdata(cnt, 3) <> "" Then
        
            cnt_2 = cnt_2 + 1
            
            If Worksheets(xdata(cnt, 1)).ProtectContents = True Then
            
                cnt_1 = cnt_1 + 1
                
            End If
            
        End If
        
    Next cnt
    
    xratio = cnt_1 / cnt_2
    
    If ActiveWorkbook.ProtectStructure Then
    
        flag = True
        
        ActiveWorkbook.Unprotect password:="Quay"
        
    Else
    
        flag = False
        
    End If
    
    If xratio >= 0.5 Then
    
        For cnt = 1 To row_tot
        
            If xdata(cnt, 2) <> "" Then
        
                Worksheets(xdata(cnt, 1)).Visible = True
                
            End If
            
            If xdata(cnt, 3) <> "" Then
            
                Worksheets(xdata(cnt, 1)).Unprotect
                
            End If
            
        Next cnt
        
'        Application.DisplayFormulaBar = True
        
'        Application.EditDirectlyInCell = True
        
    Else
    
        For cnt = 1 To row_tot
        
            If xdata(cnt, 2) <> "" Then
        
                Worksheets(xdata(cnt, 1)).Visible = False
                
            End If
            
            If xdata(cnt, 3) <> "" Then
            
                Worksheets(xdata(cnt, 1)).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
                
            End If
            
        Next cnt
        
'        Application.DisplayFormulaBar = False
       
'        Application.EditDirectlyInCell = False
        
        ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
        
    End If
    
    If flag = True Then
    
        ActiveWorkbook.Protect password:="Quay", Structure:=True, Windows:=False
    
    End If
    
    Exit Sub
    
BuildRange:
    
    xtot = Worksheets.Count
    
    If ActiveWorkbook.Path = "" Then
    
        mb = MsgBox("You must save this workbook first.", , "Could Not Find Path")
        
        End
        
    End If
    
    mb = MsgBox("This workbook does NOT contain a Range called Hide_Protect." & vbCrLf & "Do you want to build it now?", vbOKCancel, "Range Not Found")
    
    If mb = vbCancel Then
    
        Exit Sub
        
    End If
    
    xrow = ActiveCell.Row
    xcol = ActiveCell.Column
    
    xtot = Worksheets.Count
    
    xcol1 = alpha(xcol)
    
    xcol2 = alpha(xcol + 1)
    
    xcol3 = alpha(xcol + 2)
    
    mb = MsgBox("I am about to clear the contents of range " & xcol1 & xrow & ":" & xcol3 & xrow + xtot & "." & vbCrLf & "Is it okay to proceed?", vbOKCancel, "OK to DELETE?")
    
    If mb = vbCancel Then
    
        Exit Sub
        
    End If
    
    Range(xcol1 & xrow & ":" & xcol3 & xrow + xtot).Clear
    
    Range(xcol1 & xrow).Value = "Sheets in Book"
    
    Range(xcol2 & xrow).Value = "Sheets to Hide"
    
    Range(xcol3 & xrow).Value = "Sheets to Lock"
    
    Range(xcol1 & xrow + 1).Select
    
    Call Sheet_Names("Column")
    
    Range(xcol1 & xrow & ":" & xcol3 & xrow).Font.Bold = True
    Range(xcol1 & xrow & ":" & xcol1 & xrow + xtot).Font.Bold = True
    
    Range(xcol1 & xrow & ":" & xcol3 & xrow + xtot).Columns.AutoFit
    
    For cnt = xrow + 1 To xrow + xtot
    
        UserForm1.CheckBox1.Value = False
        UserForm1.CheckBox2.Value = False
        
        UserForm1.Frame1.Caption = Range(xcol1 & cnt).Value
        
        UserForm1.Show
        
        If UserForm1.CheckBox1.Value Then
        
            Range(xcol2 & cnt).Value = "Yes"
            
        End If
        
        If UserForm1.CheckBox2.Value Then
        
            Range(xcol3 & cnt).Value = "Yes"
            
        End If
    
    Next cnt
    
    If InStr(1, ActiveSheet.Name, " ") = 0 Then
    
        addy = "=" & ActiveSheet.Name & "!$" & xcol1 & "$" & xrow + 1 & ":$" & xcol3 & "$" & xrow + xtot
        
    Else
    
        addy = "='" & ActiveSheet.Name & "'!$" & xcol1 & "$" & xrow + 1 & ":$" & xcol3 & "$" & xrow + xtot
        
    End If
    
    ActiveWorkbook.Names.Add Name:="Hide_Protect", RefersTo:=addy
    
    Resume
    
End Sub

It hides and/or protects sheets in the workbook based off of values in a table... if the table does not exist, it builds it. Then you can change values in the table to change whether a sheet gets hidden, protected or both.

In this case, I hard-coded the password in place, but you can add an inputbox instead (or change the hard-coded password)

I built this for EXACTLY the reason you describe... try it out. I keep this macro on MY machine ONLY, so that other users can't get the password.

EDIT: Woops, I forgot that this won't work without the following function:

Code:

Private Function alpha(num As Integer) As String

    b = Int(num / 26)
    
    A = num Mod 26
    
    If b = 0 Or (A = 0 And b = 1) Then
    
        alpha = Chr(num + 64)
        
    Else
    
        If A = 0 Then
        
            alpha = Chr(b + 63) & "Z"
        
        Else
            
            alpha = Chr(b + 64) & Chr(A + 64)
            
        End If
        
    End If
    
End Function

Tom Urtis · Nov 16, 2005

Zakkala said:
some code that I could use for a macro that will unprotect them all? An then, presumably, very similar code that will re-protect them again!

Sub UnprotectAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Unprotect ("YourPasword")
Next ws
End Sub

Sub ProtectAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Protect ("YourPasword")
Next ws
End Sub

hatman · Nov 16, 2005

Tom Urtis said:
Zakkala said:

some code that I could use for a macro that will unprotect them all? An then, presumably, very similar code that will re-protect them again!

Click to expand...

Sub UnprotectAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Unprotect ("YourPasword")
Next ws
End Sub

Sub ProtectAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Protect ("YourPasword")
Next ws
End Sub

That is EXACTLY how I started my macro. But almost immediately I started finding shortfalls with the logic.

1) What if I have some sheets I do NOT want protected or unprotected? This method makes no provisions for skipping sheets.
2)What if I manually protect or unprotect one sheet? This can cause errors.
3) This method requires 2 buttons. I kinda like having it all taken care of in one macro so I can have one button.

Not that the simpler method can't be used... but personally I ended up making something more robust after hitting several bumps.

Tom Urtis · Nov 16, 2005

To me the key word was "all" when he wrote
"a macro that will unprotect them all"

How to deal with exceptions depends on the design of the workbook and there are so many possibilities, such as sheets hidden, by tab name or codename or index or by first 3 letters of tab name or what is in cell A1, the list could be endless, I'd defer to the workbook author to explain the criteria if there is any instead of trying to cover any & all scenarios. In this case I interpreted the exceptions as a non-issue but I could be wrong, and hopefully we'll see based on his response if there's something else to this.

hatman · Nov 16, 2005

All excellent points, Tom. I admit that the macro I wrote is certainly overkill for many applications. But I made it fairly robust to handle all of the variations that you mention. But I don't want to waste anyone's time explaining what I did if it's too big of a hammer for what he wants to do.

After all, if the simple appraoch works, that's the best way to do it.

Zakkala · Nov 17, 2005

Hello again.

Thank you both for your replies - for this workbook I think the one that deals with all sheets will do the trick; however the more in-depth one is of great interest for some of the other things I'm working on.

Thanks again - really helpful stuff.

WALTERC · Dec 1, 2005

What if I only want to unprotect and then protect one worksheet and leave the others protected

Tom Urtis · Dec 1, 2005

All you need to do is specify which sheet in the code you want to do this for.

If it is the active sheet:

ActiveSheet.Protect ("YourPassword")
ActiveSheet.Unprotect ("YourPassword")

If its a specific sheet tab name, such as named Sheet1:

Worksheets("Sheet1").Protect ("YourPassword")
Worksheets("Sheet1").Unprotect ("YourPassword")

If it is a specific index position, such as always third from the left:

Sheets(3).Protect ("YourPassword")
Sheets(3).Unprotect ("YourPassword")

If it depends on the sheet's VBA CodeName, example:

Sheet2.Protect ("YourPassword")
Sheet2.Unprotect ("YourPassword")

Macro for protecting / unprotecting worksheets

Zakkala

Active Member

Excel Facts

hatman

Well-known Member

Tom Urtis

MrExcel MVP

hatman

Well-known Member

Tom Urtis

MrExcel MVP

hatman

Well-known Member

Zakkala

Active Member

WALTERC

New Member

Tom Urtis

MrExcel MVP

Similar threads

Forum statistics

Share this page

Macro for protecting / unprotecting worksheets

Active Member

Excel Facts

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

Active Member

New Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock