Challenging Worksheet Protection Dilemma (VBA)...

[Excelophobe]

Hi all,

I'll admit now, i'm rather stuck!

I need help with coding to implement the following protection for my workbook;

Excel Workbook:
Standard workbook with the Sheet 1 labelled "home" and 2 additional worksheets available

Actions:
1. Open WB -> Password prompted, only "home" worksheet visible
1.1. Enter Admin password -> all worksheets unhidden
1.2. Enter pw1, pw2 -> only Sheet1, Sheet2 etc. unhidden (1 corresponding worksheet unhidden for every password other than "Admin") in addition to "home" sheet

2. Incorrect password -> prompted to try again
2.1. Incorrect password twice -> workbook closes

3. Exit workbook -> all worksheets bar "home" are (very)hidden

4. Bonus step: VBA code is password protected

Conditions:
1. "home" sheet/tab always visible
2. "admin" password unlocks all sheets
3. pw1, pw2 unlock only corresponding worksheets (sheet1, sheet2)
4. upon closing workbook all tabs bar "home" are very hidden
5. upon opening workbook, only "home" tab visible, and incorrect password entered twice closes workbook

I REALLY appreciate any help!

Many thanks,

Excelophobe

 

[Hui]

I'd use some code like:

Private Sub Workbook_Open()
Dim Pass As Integer
Dim Ans As String

Sheets("Sheet1").Visible = xlVeryHidden
Sheets("Sheet2").Visible = xlVeryHidden
Sheets("Sheet3").Visible = xlVeryHidden

Pass = 0

10: Ans = InputBox("Enter Password", "Enter Password", "*******")

Select Case Ans
  Case "Admin"
  Sheets("Sheet1").Visible = True
  Sheets("Sheet2").Visible = True
  Sheets("Sheet3").Visible = True
  Sheets("Sheet1").Select

  Case "PW1"
  Sheets("Sheet1").Visible = True
  Sheets("Sheet1").Select

  Case "PW2"
  Sheets("Sheet2").Visible = True
  Sheets("Sheet2").Select

  Case "PW3"
  Sheets("Sheet3").Visible = True
  Sheets("Sheet3").Select

  Case Else
  Pass = Pass + 1
  If Pass > 2 Then
  Sheets("Sheet1").Visible = xlVeryHidden
  Sheets("Sheet2").Visible = xlVeryHidden
  Sheets("Sheet3").Visible = xlVeryHidden
  ActiveWorkbook.Close SaveChanges:=True
  End If
  GoTo 10

End Select

End Sub

It must be in the Workbook module in VBA

See attached file:

VBA Password is Admin, Other passwords in the code above

 

[Excelophobe]

Hi Hui

Thanks so much for your help!

Unfortunately i can't open the file - site error.

 

[Hui]

You can copy the code above and place it into a new file
Add a worksheet called "Home"
Save and Close the file as a *.xlsb file type
Reopen
enjoy

 

[Excelophobe]

Hi Hui,

When i open your workbook and enter 3 incorrect passwords in a row the program gives me a run-time error '1004' and does not close. Can you please help with this?

Everything else works fine.

Many thanks,

 

[Hui]

Whoops

Try this file instead:

Original file and code is ammended

 

[Excelophobe]

Amazing thank you.

Is there a way to incorporate auto-saving into the code? (i.e. to get rid of the save? prompt upon closing)

And is it possible to close the program as opposed to just the active workbook?

 

[Hui]

Re-download the file
I have already added that
Refer to the code above

 

[Excelophobe]

Thank you.

Is it possible to have the passwords displayed as asterisks when being entered?

 

[prasaddn]

Hi,

the Inputbox / msgbox functions are windows built in dialog box and I believe we do not have the option to set the text displayed in asteriks.

To achieve your need, you have to create an userform and load them on workbook open. the userform can have labels and textfields. For the textfields you can set the "passwordchar" property as "*" or any single char of your choice.

Regards,
Prasad DN
PS: Hui, hope you didn't mind me responding to this.

 

[Hui]

Please see attached file:

 

[Excelophobe]

Hi, that's great. Really exceptional.

Is it possible to add in an element of structure protection?

*EDIT* actually this is the really important final step - any help will be really appreciated

 

[Excelophobe]

To add - is it also possible to embed structural protection so that it can be toggled?

e.g. workbook is protected for structure in all logins apart from a new layer, passworded as "Developer" for example, which unlocks the structure as well as granting access to all worksheets like "Admin" does?

 

[Hui]

See attached file:

 

[Excelophobe]

Hi, in the latest file the structure isn't protected - i am able to move, delete, and add worksheets under all logins. I was wandering if it's possible to limit structural changes to "Developer" login only.

 

[Hui]

Try this
You will see the lines in the VBA to Protect and Unprotect the workbook structure, so copy these as required
Workbook password is Admin2

 

[Excelophobe]

Hi Hui,

Everything i try returns the "Unable to set visible property of the Worksheet class" error.

I've reverted back to the pre-Developer file and tried to set the condition for "Admin" login.

Generic code:

Private Sub Workbook_Open()
Dim Pass As Integer
Dim Ans As String

Sheets("Sheet1").Visible = xlVeryHidden
Sheets("Sheet2").Visible = xlVeryHidden
Sheets("Sheet3").Visible = xlVeryHidden

Pass = 0

10: UserForm1.Show
Ans = UserForm1.TextBox1.Text

'10: Ans = InputBox("Enter Password", "Enter Password", "*******")

Select Case Ans
  Case "Admin"
    Sheets("Sheet1").Visible = True
    Sheets("Sheet2").Visible = True
    Sheets("Sheet3").Visible = True
    Sheets("Sheet1").Select
   
  Case "PW1"
    Sheets("Sheet1").Visible = True
    Sheets("Sheet1").Select
 
  Case "PW2"
    Sheets("Sheet2").Visible = True
    Sheets("Sheet2").Select
 
  Case "PW3"
    Sheets("Sheet3").Visible = True
    Sheets("Sheet3").Select

  Case Else
    Pass = Pass + 1
    If Pass > 2 Then
      Sheets("Sheet1").Visible = xlVeryHidden
      Sheets("Sheet2").Visible = xlVeryHidden
      Sheets("Sheet3").Visible = xlVeryHidden
      ActiveWorkbook.Close SaveChanges:=True
    End If
    GoTo 10
   
End Select

End Sub

Can you assist with incorporating conditional structural protection into this version please. (condition: structure protected for PW1,2&3, unprotected for Admin)

Regards,