Require password input from all UNLESS the user is a specific name

Try the code below on a copy of your workbook as untested

Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False

    Dim wSheet          As Worksheet
    Dim Pwd             As String

    If Environ("USERNAME") = "Bloggs, Joe" Then
        For Each wSheet In Worksheets
            wSheet.Unprotect
        Next
    Else
        Pwd = InputBox("Enter your password to unprotect all worksheets", "Password Input")
        On Error Resume Next
        For Each wSheet In Worksheets
            wSheet.Unprotect Password:=Pwd
        Next wSheet
        If Err <> 0 Then
            MsgBox "For access please contact  " & _
                   "This Person", vbCritical, "Please Try Again"
        End If
        On Error GoTo 0
        Application.ScreenUpdating = True
        ThisWorkbook.Save
    End If
End Sub

That is a bit strange as I tried it later in the day on my laptop and it worked for me. Did you type in your username exactly as it is written? I.e. No different spaces. The username is the name you sign on to your pc with and it must be exactly the same as the password. On my phone until this evening and so I won't be able to test anything until then.

MsgBox "Current user is " & Environ("UserName")

It sounds like you need the code for your username in a workbook open event . I will have a look this evening when I get in. As for the sheets needing to have the password entered for each sheet I didn't alter your original code but again I will have a look when I get in

Hi Richard, Try placing the code below in the ThisWorkbook module. Leave your original code in the standard module.

To place code in the ThisWorkbook module

Copy the Excel VBA code that you want to use
Select the workbook in which you want to store the code
Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
In the Project Explorer, find your workbook, and open the list of Microsoft Excel Objects
Right-click on the ThisWorkbook object, and choose View Code
Where the cursor is flashing, choose Edit | Paste

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim myPassword As String
    Dim wSheet As Worksheet
myPassword = "Pwd"
    If Environ("USERNAME") = "richard.galvin" Then
        For Each wSheet In ActiveWorkbook.Worksheets
         wSheet.Unprotect Password:=myPassword
        Next
        End If
Application.ScreenUpdating = True
End Sub

sorry, few final questions to this if i may, how do i add more than one username to this code, and is it possible to have a text box/user form/ etc pop up, so when it sees the name that allows the sheets to be unlocked, pops up and asks - "Unlock All?" clicking yes unlocks, clicking no leaves locked?

kind regards.

I will see if I can get a chance to have a look this evening if I get a chance when I am on my pc rather than my phone

Hi Rich, try putting this in the ThisWorkbook module

Private Sub Workbook_Open()
    Dim objNet As Object
    Dim Msg As String
    Set objNet = CreateObject("WScript.NetWork")
    Select Case objNet.UserName
    Case Is = "Clve", "richard.galvin", "John", "Mary"
        Call Rich2
    Case Else
        Call Rich1
    End Select
End Sub

And put the code below in a standard module

Sub Rich1()
    Dim wSheet As Worksheet
    Dim Pwd As String
    Application.ScreenUpdating = False
    Pwd = InputBox("Enter your password to unprotect all worksheets", "Password Input")
    On Error Resume Next
    For Each wSheet In Worksheets
        wSheet.Unprotect Password:=Pwd
    Next wSheet
    If Err <> 0 Then
        MsgBox "For access please contact  " & _
               "This Person", vbCritical, "Please Try Again"
    End If
    On Error GoTo 0
    Application.ScreenUpdating = True
    ThisWorkbook.Save
End Sub
Sub Rich2()
Dim myPassword As String
Dim wSheet As Worksheet
Dim Rly As Integer
Application.ScreenUpdating = False
    Rly = MsgBox("You have been granted access. To unlock all sheets press Yes", 68)
  If Rly = 6 Then
myPassword = "Pwd"
On Error Resume Next
For Each wSheet In ActiveWorkbook.Worksheets
         wSheet.Unprotect Password:=myPassword
        Next
        Else
       Exit Sub
       End If
Application.ScreenUpdating = True
End Sub

Please note: You should really take the solved off the post if you are adding another question.