VBA Issue with Worksheet Protection Passwords

grahamd_41

New Member
Joined
Jan 26, 2016
Messages
9
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.

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

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.
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

grahamd_41

New Member
Joined
Jan 26, 2016
Messages
9
I have included my code below in the hope to attract some attention:
Code:
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
 

grahamd_41

New Member
Joined
Jan 26, 2016
Messages
9

ADVERTISEMENT

I have highlighted the line causing the issue below

Code:
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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
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

New Member
Joined
Jan 26, 2016
Messages
9

ADVERTISEMENT

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.
 

grahamd_41

New Member
Joined
Jan 26, 2016
Messages
9
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

New Member
Joined
Jan 26, 2016
Messages
9
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.
 

Forum statistics

Threads
1,141,479
Messages
5,706,621
Members
421,460
Latest member
Taamrak

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top