Password Protecting/Unprotecting A List of Excel Sheet Names

Password Protect Unprotect List of Excel Spreadsheet Tabs

What This VBA Code Does

Today, a colleague of mine described to me a situation (aka annoyance) he was trying to automate. He had an Excel file with a bunch of tabs created, however, only a handful of tabs required password protection upon the files distribution. The pain point was all the time spent unprotecting and re-protecting the sheets each time he was working in the file. Knowing I had a little bit of experience working with Excel, he asked if there was a way to resolve this very manual task.

Below is the solution I whipped up which let him list out the specific sheet names that required the password protection and allowed him to toggle on/off the password protection. I even threw in some nifty error messages if sheets were not found, had name changes, or were protected with a different password. Enjoy!

VBA Code:

Sub SheetProtection_Toggle()
'PURPOSE: Add/Remove password protection to a list of tab names
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim SheetArray As Variant
Dim sht As Worksheet
Dim Password As String
Dim NotFoundList As String
Dim WrongPasswordList As String
Dim ProtectionStateDetermined As Boolean
Dim UnprotectSheet As Boolean
Dim x As Long

'INPUTS
  SheetArray = Array("Sheet1", "Sheet2", "Sheet4")
  Password = "Password123"

'Loop through each sheet name
  For x = LBound(SheetArray) To UBound(SheetArray)
    'Store Sheet Object to Variable
      On Error Resume Next
      Set sht = Nothing
      Set sht = ActiveWorkbook.Sheets(SheetArray(x))
      On Error GoTo 0
    
    'Was Sheet found in Activeworkbook?
      If Not sht Is Nothing Then
        'Determine if we need to protect or unprotect these sheets (based off of first instance)
          If ProtectionStateDetermined = False And (sht.ProtectContents Or sht.ProtectDrawingObjects Or sht.ProtectScenarios) Then UnprotectSheet = True
          ProtectionStateDetermined = True
    
        'Lock/Unlock worksheet
          If UnprotectSheet = True Then
            On Error Resume Next
            sht.Unprotect Password
            If sht.ProtectContents = True Then WrongPasswordList = WrongPasswordList & "• " & SheetArray(x) & Chr(10)
            On Error GoTo 0
          Else
            sht.Protect Password
          End If
        
      Else
        'Store a list of sheets not found in the ActiveWorkbook
          NotFoundList = NotFoundList & "• " & SheetArray(x) & Chr(10)
      End If
  Next x

'Report what was done to the worksheets
  If UnprotectSheet = True Then
    MsgBox "Sheets Unprotected!"
  Else
    MsgBox "Sheets Protected!"
  End If

'Report any sheet names that were not found (if applicable)
  If NotFoundList <> "" Then
    MsgBox "The following Worksheets were not found in your Excel file:" & Chr(10) & Chr(10) & Trim(NotFoundList)
  End If

'Report any sheets that cound not be unprotected (if applicable)
  If WrongPasswordList <> "" Then
    MsgBox "The following Worksheets were unable to be unprotected:" & Chr(10) & Chr(10) & Trim(WrongPasswordList)
  End If

End Sub

Bonus Tip!

For convenience, try adding this VBA macro to your QAT (Quick Access Toolbar). Simply click the little down arrow at the very end of the toolbar (shown below just to the right of the red box) and select More Commands. Then do the following:

  1. Change the “Choose Commands from” drop down to Macros

  2. Find the SheetProtection_Toggle macro and select it

  3. Click the Add>> button

  4. With the button selected in the Quick Access Toolbar list (right-hand side), you can change the button name and icon by clicking the Modify button

  5. Click the OK button to save your changes

Protection Toggle Button To QAT.png

How Do I Modify This To Fit My Specific Needs?

Chances are this post did not give you the exact answer you were looking for. We all have different situations and it's impossible to account for every particular need one might have. That's why I want to share with you: My Guide to Getting the Solution to your Problems FAST! In this article, I explain the best strategies I have come up with over the years to getting quick answers to complex problems in Excel, PowerPoint, VBA, you name it

I highly recommend that you check this guide out before asking me or anyone else in the comments section to solve your specific problem. I can guarantee 9 times out of 10, one of my strategies will get you the answer(s) you are needing faster than it will take me to get back to you with a possible solution. I try my best to help everyone out, but sometimes I don't have time to fit everyone's questions in (there never seem to be quite enough hours in the day!).

I wish you the best of luck and I hope this tutorial gets you heading in the right direction!

Chris
Founder, TheSpreadsheetGuru.com