CODEWITHSUNDEEP
excel
T-Rex
T-Rex

Reputation: 161

Excel 2016 Password Protection with unique password and able to filter rows

I have a file that needs to be Protected by password. However, the code I have for protecting and unprotecting is a generic one and not a specific one. Hence, anyone can put there own password into the message box to unlock or lock. I would like only one password to be used for protecting and unprotecting the workbook. Here is the code that I am utilizing and I appreciate your advisement:

Sub sbProtectAllSheets()
Dim pwd1 As String, pwd2 As String

Call mcr_HideRowsColumns

pwd1 = InputBox("Please Enter the password", "Password Input")
If pwd1 = "" Then Exit Sub
pwd2 = InputBox("Please re-enter the password", "Password Input")
If pwd2 = "" Then Exit Sub
'Check if both the passwords are identical
If InStr(1, pwd2, pwd1, 0) = 0 Or _
InStr(1, pwd1, pwd2, 0) = 0 Then
MsgBox "You entered different passwords. No action taken"
Exit Sub
End If
For Each ws In Worksheets
ws.Protect Password:=pwd1, AllowFiltering:=True
Next
MsgBox "All sheets Protected."


'-------------------------------------------
Sheets("Home").Select
Range("A1").Select

Exit Sub
End Sub

And Unprotect:

Sub sbUnProtectAll()
On Error GoTo ErrorOccured
Dim pwd1 As String

pwd1 = InputBox("Please Enter the password", "Password Input")
If pwd1 = "" Then Exit Sub
For Each ws In Worksheets
ws.Unprotect Password:=pwd1
Next
Call mcr_UnhideRowsColumns

MsgBox "All sheets UnProtected."

Exit Sub
ErrorOccured:
MsgBox "Sheets could not be UnProtected - Password Incorrect"

Exit Sub
End Sub

The Call features are just hiding and unhiding rows that I do not want users to see. Thank you very much for your input.

Upvotes: 0

Views: 147

Answers (1)

Solar Mike
Solar Mike

Reputation: 8375

I found this: Sincere apologies to the original person who wrote it and Thanks!

Sub protectAll()
Dim myCount
Dim i
myCount = Application.Sheets.Count
Sheets(1).Select
For i = 1 To myCount
    ActiveSheet.Protect "your-password", true, true
    If i = myCount Then
        End
    End If
    ActiveSheet.Next.Select
Next i

End Sub

Sub UnprotectAll()
    Dim myCount
    Dim i
    myCount = Application.Sheets.Count
    Sheets(1).Select
    For i = 1 To myCount
        ActiveSheet.Unprotect "your-password"
        If i = myCount Then
            End
        End If
        ActiveSheet.Next.Select
    Next i
End Sub

Which sets a password on all sheets, but if the user needs to enter data somewhere then you need to un-protect those cells... I use it to stop people "accidently" deleting my formulae - usually with the excuse "I couldn't understand what it was doing so I deleted it". Hope it helps.

Upvotes: 0

Related Questions