Protect single sheets in the woorkbook

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi!

I have got more users for my worksheet. I would like each user to be able to
watch his/her sheet. That means visibility should be secure by a password.
The best would be if I could be "admin":-)

How can I do that???

I know that security in Excel is thin, but in this case a little security is
better than nothing.

Please give me some advise!


Best Regards
 
As you say, the security on Excel is very weak and anyone with the knowlege
and the will to do so will crack it without doubt, but provided you don't
have any code experts that are determined to break it, it can be done quite
easily.
I've been using this on a Defect Analysis system where several different
people do the inputting for a few years now without problem.
All it basically does is to hide all the worksheets except one, the header
sheet. This is initially achieved using the Workbook Open event in This
Workbook :-

Private Sub Workbook_Open()
Sheet2.Visible = xlSheetVeryHidden
Sheet3.Visible = xlSheetVeryHidden
End Sub

I use 'VeryHidden' as it doesn't show the sheet at all, not even in the
'Format' > 'Sheet' screen, the 'Unhide' option is grayed out so there's no
indication that any hidden sheet exists.

To give users access you can use something like this, you can put it in a
module with a Command Button to run it or just incorporate it into the
Workbook Open event. A box asking for a password will appear:-

Sub HideWorksheets()
Dim Reply
Sheet2.Visible = xlSheetVeryHidden
Sheet3.Visible = xlSheetVeryHidden
Reply = InputBox("Please Enter Your Passsword")
If Reply = "Password1" Then
Sheet2.Visible = True
Else
If Reply = "Password2" Then
Sheet3.Visible = True
Else
If Reply = "Admin" Then
Sheet2.Visible = True
Sheet3.Visible = True
Else: GoTo Error
End If: End If: End If
Exit Sub
Error: MsgBox "Incorrect Password"
End Sub

Remember that only Sheet 1 is visible on opening. If you enter 'Password1',
Sheet 2 becomes visible, 'Password2', Sheet 3 becomes visible, 'Admin' makes
Sheet 2 and Sheet 3 visible. If a non existent password is entered the error
message pops up.

Try pasting the code into a new workbook to try it out.

Don't forget to password protect the VB editor!

Hope this is of use, please post back if anything is unclear,
Regards,
Alan.
 
Hey Alan!

Wow, great! It works!

The fact is that I would just like to try that solution for ten
users/sheets. I have tried to extend the code:

Sub HideWorksheets()
Dim Reply
Ark2.Visible = xlSheetVeryHidden
Ark3.Visible = xlSheetVeryHidden
Ark4.Visible = xlSheetVeryHidden
Ark5.Visible = xlSheetVeryHidden
Ark6.Visible = xlSheetVeryHidden
Ark7.Visible = xlSheetVeryHidden
Ark8.Visible = xlSheetVeryHidden
Ark9.Visible = xlSheetVeryHidden
Ark10.Visible = xlSheetVeryHidden
Reply = InputBox("Please Enter Your Passsword")
If Reply = "Password2" Then
Ark2.Visible = True
Else
If Reply = "Password3" Then
Ark3.Visible = True
Else
If Reply = "Password4" Then
Ark4.Visible = True
Else
If Reply = "Password5" Then
Ark5.Visible = True
Else
If Reply = "Password5" Then
Ark6.Visible = True
Else
If Reply = "Password7" Then
Ark7.Visible = True
Else
If Reply = "Password8" Then
Ark8.Visible = True
Else
If Reply = "Password9" Then
Ark9.Visible = True
Else
If Reply = "Password10" Then
Ark10.Visible = True
Else
If Reply = "Admin" Then
Ark2.Visible = True
Ark3.Visible = True
Ark4.Visible = True
Ark5.Visible = True
Ark6.Visible = True
Ark7.Visible = True
Ark8.Visible = True
Ark9.Visible = True
Ark10.Visible = True
Else: GoTo Error
End If: End If: End If: End If: End If: End If: End If: End If: End If: End
If:
Exit Sub
Error: MsgBox "Incorrect Password"
End Sub

Unfortunately that doesn't work:( Any ideas??

Afterwards I will try to make an Admin sheet where it's possible to get a
comprehensive view of the individual data.

Thanks a lot!

Aron

"Alan" skrev:
 
Hey!

The code worked out for me in the end...

I'm happy about that! Now I would just like a "Logout"-button, which closes
the sheet and the workbook. Saves firts...

Does anyone know if it's a good idea to make the workbook "shared" in case
of two people "updating" their sheets at the same time from different pcs.
(The workbook will be placed on the server)!






"Aron" skrev:
 
Try this version to get you closer.

Sub HideWorksheets()
Dim Reply As String
Reply = InputBox("Please Enter Your Passsword")
Select Case Reply
Case Is = "Password2"
Sheets("Ark2").Visible = True
Case Is = "Password3"
Sheets("Ark3").Visible = True
Case Is = "Password4"
Sheets("Ark4").Visible = True
'add more cases to suit
Case Is = "Admin"
For n = 1 To Sheets.Count
Sheets(n).Visible = True
Next n
End Select
End Sub

Note: since you have not protected the workbook with a password, error checking
is not an option.

Also............Add this to Thisworkbook module to hide all sheets except Ark1
when workbook opens.

Private Sub Workbook_Open()
Dim n As Single
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Ark1" Then
ws.Visible = xlVeryHidden
End If
Next ws
End Sub


Gord Dibben MS Excel MVP
 
Sub LogOut()
Dim Repsonse
Response = MsgBox("Do you want to update and exit?", vbYesNo, "Caution . .
..")
If Response = vbYes Then
ThisWorkbook.Save
MsgBox "File Saved, Click OK to exit."
ThisWorkbook.Close
End If
End Sub

I'm not sure if sharing the file is a good idea, not sure what would happen
with two users looking at different sheets with the rest hidden and one of
them saved the file,
Regards,
Alan.
 
Thank you GOrd and Alan!

I could use everything and it works:D

But: "
Private Sub Workbook_Open()
Dim n As Single
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Ark1" Then
ws.Visible = xlVeryHidden
End If
Next ws
End Sub "

didn't work out for me.

I'm done with my sheet now. The only problem I have is how to secure that
all the information is saved, when each person opens the file form the server.

Ideas are very welcome!


I thank you once again, great support!
 
"Subscript out of Range".

When I try to show a sheet i get that message. I have no idea, what suddenly
happened. Any suggestions?

The code is:
Sub HideWorksheets()
Dim Reply As String
Reply = InputBox("Bitte Kennwort eingeben")
Select Case Reply
Case Is = "p2"
Sheets("Ark2").Visible = True
Case Is = "p3"
Sheets("Ark3").Visible = True
Case Is = "p4"
Sheets("Ark4").Visible = True
Case Is = "p5"
Sheets("Ark5").Visible = True
Case Is = "p6"
Sheets("Ark6").Visible = True
Case Is = "p7"
Sheets("Ark7").Visible = True
Case Is = "p8"
Sheets("Ark8").Visible = True
Case Is = "p9"
Sheets("Ark9").Visible = True
Case Is = "p10"
Sheets("Ark10").Visible = True
Case Is = "p11"
Sheets("Ark11").Visible = True
'tilføj flere, for at tilpasse
Case Is = "Admin"
For n = 1 To Sheets.Count
Sheets(n).Visible = True
Next n
End Select
End Sub

I'm confused. Don't know what's happening:(

"Aron" skrev:
 
"Subscript out of Range" means that the code is looking for something, a
worksheet in this case and can't find it. Are you sure that all the sheets
exist? Have you renamed or deleted one?
 
@ Alan!

Everything excists and I don't really see the problem. I discorevered after
I hade personalised the passwords and protected some of the sheets!

But how will I be able to get it back to normal? The "debug" function
doesn't help me much:(

"Alan" skrev:
 
Hi Alan,

I've used this and it works a treat but am having trouble amending it to do
something slightly different.....

What I would like to do is to have say 4 worksheets being available to use
on opening a workbook (not just one) and have another two worksheets "hidden"
away that need a password to open them?

Sorry if this is a really easy question, but how do I password protect the
VB Editor?
 
Back
Top