VBA Issue with Worksheet Protection Passwords

[grahamd_41]

Hi all, I'm new to the forum although have been helped by it on many occasions.

I have come across a problem while trying to use VBA to protect my worksheet and was wondering if anyone else has had a similar issue.

Essentially I am adding two levels of protection; one level for the end user of the spread sheet and another level for my colleagues to modify the data without deleting or moving formulas/cells.
There is probably other ways of achieving what I have done, but after much Google and my limited knowledge of coding this is what I came up with.

Using a loop activated by a button press I UNLOCK editing capabilities:

• Request a password from the user (pwd)
• Loop through my worksheets
• Unprotect worksheet with pwd
• Unlock some cells
• Protect without any password

On a second press of the button I LOCK editing capabilities

• Loop through my worksheets
• Unprotect the worksheet without password
• Lock some cells
• Protect with pwd

pwd is stored hidden in my workbook


With many breakpoints and step by step processing I found the problem I'm experiencing is at the exact point when trying to protect the worksheet (in BOLD), Excel throws up the "Unprotect Sheet" dialog box and asks for a password.

Why when trying to protect a sheet does it ask for an unprotect password?

Any ideas anyone? I've tried all sorts but the only cure I have found is using a password at this point. I don't want to have to do this as I want my colleagues to have the ability when required to gain full access to the spread sheet without needing a password.

 

[Andrew Poulsom]

Welcome to MrExcel.

I think it would help to see your actual code rather than a description of it.

 

[grahamd_41]

I have included my code below in the hope to attract some attention:

Sub psds_unlock()
'   Freeze screen
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim pwd As String
    Dim Ipwd As String
    Dim locked As Boolean
        
    If Worksheets(1).Range("S57").Value = "n" Then
        locked = False
    ElseIf Worksheets(1).Range("S57").Value = "y" Then
        locked = True
    End If

    If locked = False Then
        answer = MsgBox("Are you sure you want to lock the workbook?", vbYesNo + vbQuestion, "Lock Workbook?")
        If answer = vbYes Then
            With Worksheets(1)
                pwd = .Range("R56").Value
                .unprotect
                .Range("S57").Value = "y"
' Change button text
                .Shapes.Range(Array("Button 1")).Select
            End With
            Selection.Characters.Text = "Unlock Workbook"
    
            '--------------Lock----------------
            For Each ws In Worksheets
                Call protect(ws, pwd)
            Next ws
            '----------------------------------
            
        End If
        ActiveWorkbook.protect Password:=pwd, Structure:=True, Windows:=True
        Worksheets(1).Activate
    ElseIf locked = True Then
        Ipwd = InputBox("Please enter the password:")
        On Error GoTo ErrHandler
        
        '-------------Unlock---------------
        For Each ws In Worksheets
            Call unprotect(ws, Ipwd)
        Next ws
        '----------------------------------
                
        With Worksheets(1)
            .unprotect
            .Activate
            .Range("S57").Value = "n"
' Change button text
            .Shapes.Range(Array("Button 1")).Select
            Selection.Characters.Text = "Lock Workbook"
            .protect
        End With
        
        ActiveWorkbook.unprotect Password:=Ipwd
    End If
    
    Range("K46").Select
    
'   Unfreeze screen
    Application.ScreenUpdating = True
    
Exit Sub
ErrHandler:
        MsgBox "Password incorrect!", vbExclamation
End Sub

Private Sub protect(ByVal ws As Worksheet, ByVal pwd As String)
    ws.unprotect
    
    'if cables sheet
    If ws.Range("A5").Value = "1" Then
        ws.Range("B5:D54").locked = True
        ws.Range("I5:I54").locked = True
        ws.Range("L5:L54").locked = True
        ws.Range("P5:P54").locked = True
        ws.Range("R5:R54").locked = True
        ws.Range("T5:U54").locked = True
        ws.Range("AB5:AB54").locked = True
        ws.Range("AJ5:AJ54").locked = True
        ws.Range("E2:AI2").locked = True
    End If
    
    If ws.Name = "COVER" Then
        ws.Range("A1:P57").locked = True
    End If
        
    If ws.Name = "CABLES Summary" Then
        ws.Range("D6:D134").locked = True
    End If
    
    If ws.Name = "EQUIPMENT" Then
        ws.Range("C4:E453").locked = True
        ws.Range("G4:Q453").locked = True
    End If
    
    ws.protect Password:=pwd, AllowFiltering:=True
    ws.EnableSelection = xlNoRestrictions
End Sub

Private Sub unprotect(ByVal ws As Worksheet, ByVal Ipwd As String)
    ws.unprotect Password:=Ipwd
    
    'if cables sheet
    If ws.Range("A5").Value = "1" Then
        ws.Range("B5:D54").locked = False
        ws.Range("I5:I54").locked = False
        ws.Range("L5:L54").locked = False
        ws.Range("P5:P54").locked = False
        ws.Range("R5:R54").locked = False
        ws.Range("T5:U54").locked = False
        ws.Range("AB5:AB54").locked = False
        ws.Range("AJ5:AJ54").locked = False
        ws.Range("E2:AI2").locked = False
        
        Call hideFormulas(ws)
        ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True
    End If
    
    If ws.Name = "COVER" Then
        ws.Range("A1:P57").locked = False
        ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True
    End If
    
    If ws.Name = "CABLES Summary" Then
        ws.Range("D6:D134").locked = False
        Call hideFormulas(ws)
        ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True
    End If
    
    If ws.Name = "GLAND Summary" Then
        'both levels same protection
        Call hideFormulas(ws)
        ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True
    End If
        
    If ws.Name = "EQUIPMENT" Then
        ws.Range("C4:E453").locked = False
        ws.Range("G4:Q453").locked = False
        Call hideFormulas(ws)
        ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True
    End If
End Sub

Private Sub hideFormulas(ByVal ws As Worksheet)
    Dim R As Range
    
    ws.UsedRange.FormulaHidden = False
    
    Set R = SpecialCells(ws.UsedRange, xlCellTypeFormulas)
    If R Is Nothing Then Exit Sub
    R.FormulaHidden = True
    R.locked = True
End Sub

Private Function SpecialCells(ByVal R As Range, ByVal Typ As XlCellType, Optional ByVal Value As XlSpecialCellsValue = &H17) As Range
    On Error Resume Next
    Select Case Typ
        Case xlCellTypeConstants, xlCellTypeFormulas
        Set SpecialCells = Intersect(R, R.SpecialCells(Typ, Value))
        Case Else
        Set SpecialCells = Intersect(R, R.SpecialCells(Typ))
    End Select
End Function

 

[Andrew Poulsom]

Which line causes the error?

 

[grahamd_41]

I have highlighted the line causing the issue below

Private Sub unprotect(ByVal ws As Worksheet, ByVal Ipwd As String)
    ws.unprotect Password:=Ipwd
    
    'if cables sheet
    If ws.Range("A5").Value = "1" Then
        ws.Range("B5:D54").locked = False
        ws.Range("I5:I54").locked = False
        ws.Range("L5:L54").locked = False
        ws.Range("P5:P54").locked = False
        ws.Range("R5:R54").locked = False
        ws.Range("T5:U54").locked = False
        ws.Range("AB5:AB54").locked = False
        ws.Range("AJ5:AJ54").locked = False
        ws.Range("E2:AI2").locked = False
        
        Call hideFormulas(ws)
        [B][COLOR="#FF0000"]ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True[/COLOR][/B]
    End If
    
    If ws.Name = "COVER" Then
        ws.Range("A1:P57").locked = False
        [B][COLOR="#FF0000"]ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True[/COLOR][/B]
    End If
    
    If ws.Name = "CABLES Summary" Then
        ws.Range("D6:D134").locked = False
        Call hideFormulas(ws)
        [B][COLOR="#FF0000"]ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True[/COLOR][/B]
    End If
    
    If ws.Name = "GLAND Summary" Then
        'both levels same protection
        Call hideFormulas(ws)
        [B][COLOR="#FF0000"]ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True[/COLOR][/B]
    End If
        
    If ws.Name = "EQUIPMENT" Then
        ws.Range("C4:E453").locked = False
        ws.Range("G4:Q453").locked = False
        Call hideFormulas(ws)
        [B][COLOR="#FF0000"]ws.protect Contents:=True, AllowFiltering:=True, AllowFormattingCells:=True[/COLOR][/B]
    End If
End Sub

 

[Andrew Poulsom]

Not a direct answer to your question but it's not advisable to have procedures with the same names as VBA properties/methods, ie protect and unprotect. What happens if you rename them?

 

[grahamd_41]

Thanks for the tip, unfortunately this doesn't solve the problem but I can see why it is not advisable.
I have many Excel documents with this code in that have worked, the problem doesn't occur on all of them, only the odd one. One of the files works fine at first then developed this issue after being closed and reopened.

 

[Andrew Poulsom]

Is the worksheet already protected when the error occurs?

 

[grahamd_41]

No, the "Unprotect Sheet" password prompt appears when trying to protect the sheet.
Nor is the worksheet protected when trying to carry out this command.

 

[grahamd_41]

Interestingly, the prompt appears for each individual sheet if I hit Escape each time the box appears. The rest of the code is carried out but none of the sheets are protected.