Hide sheet from view with password

[nparsons75]

Hi,

I have an excel file containing a number of sheets, I will name them sheet 1,2,3,4 and 5.

The issue I have have is this.

Sheet 1 and 2 need to be restricted access. Only certain people can view / edit as they contain sensitive data. Sheets 3,4 and 5 are open access and can be viewed by anyone.

Is there a way of password protecting or another method so that that only certain people can access sheet 1 and 2.

Currently to do this I am having to have two independent workbooks (restricted and open access).

Thanks

 

[nparsons75]

Hi,

its very strange, I have just tried on another version that I hadn't applied the code, when opening it does exactly the same.

worksheet open code, this is all the code i have in 'this workbook' Everything other than your code at the bottom is being ignored with '

Could the workbook open code be anywhere else.

'Private Sub Workbook_Open()'Application.DisplayFullScreen = True
'Worksheets("menu").Activate
'Worksheets("menu").ScrollArea = "A1:ac42"
'Application.WindowState = xlMaximized
'ActiveWindow.WindowState = xlMaximized
'ActiveWindow.Zoom = False
'ActiveSheet.Range("A1:AC1").Select
'If Selection.Width > ActiveWindow.Width Then
'ActiveWindow.Zoom = True
'Call RefreshAll
'End If
'End Sub




'Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'End Sub
'If Not Success Then Exit Sub
'Const backupFolder = "O:\ProAction\BACKUPS"


'Dim savedName As String
'Dim backupName As String
'Dim dotFinder As Long


'Application.EnableEvents = False
'savedName = ThisWorkbook.FullName
'backupName = backupFolder & Mid$(savedName, InStrRev(savedName, "\"))
'dotFinder = InStrRev(backupName, ".")
'backupName = Left$(backupName, dotFinder) & Format$(Now(), "yyyymmddhhnnss.") & Mid$(backupName, dotFinder + 1)
'If backupName = savedName Then Exit Sub
'If Dir$(backupName) <> "" Then Kill backupName
'ThisWorkbook.SaveAs backupName
'Kill savedName
'ThisWorkbook.SaveAs savedName
'Application.EnableEvents = True


'End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("strategic objectives").Visible = xlSheetVeryHidden
'Sheets("Sheet2").Visible = xlSheetVeryHidden
Sheets("strategic objectives").Protect Password:="private"
'Sheets("Sheet2").Protect Password:="passwordhere"
ActiveWorkbook.Save
End Sub

 

[nparsons75]

what is also strange it that the filename it says it can no longer find is an old one. I have version numbers, currently on 2.0, it is saying it cannot find my last one version 1.1

 

[nparsons75]

I have removed all macros yet it still happens. Could it be that the code has corrupted it somehow?

 

[Scott T]

Not sure what is happening maybe someone else can help.

 

[nparsons75]

Hi, I have managed to get it working by rebuilding my workbook, it must have been corrupt somehow. The password access is working great now but I would like to be able to enhance it by the following:

I would like an option to pop up when the file has been opened for the user to select (with or without hidden sheets). For example, some users, the ones who will have access to use the hidden sheets will select yes, then be prompted for the password. Users who do not have the access or password and want to by pass the password request will select no and the password option will be skipped.

If the password is typed in incorrectly the offer the chance to retry

When the password has been accepted, I would like to set the sheet in which the workbook opens

Would this be possible, this would make the system perfect.

 

[Scott T]

Try

Private Sub Workbook_Open()
havepass = MsgBox("Put your do you want to unhide sheet text here", vbYesNo + vbQuestion)
If havepass = vbYes Then
    pword = InputBox("enter password")
    If pword = "password" Then
        Sheets("Sheet1").Visible = True
        Sheets("Sheet2").Visible = True
        Sheets("Sheet1").Unprotect ("passwordhere")
        Sheets("Sheet2").Unprotect ("passwordhere")
        Sheets("Sheet1").Activate 'change this to the sheet you want to be active when the correct password is entered.
    Else
        MsgBox ("Incorect password")
    End If
  
End If
 
End Sub

 

[nparsons75]

Hi, thank you very much for the code. I have installed but something is not quite right, probably me!!

When I get the message box pop up for: MsgBox("Put your do you want to unhide sheet text here" The passowrd is visible in this box above where it needs inputting.

Is there also a way of giving the user another chance to input the password if entered incorrectly?

Thank you very much for your help.

 

[nparsons75]

oops, my fault...I input the password here by mistake.

pword = InputBox("enter password")

However, I cannot get it to recognise the passowrd, it keeps telling me wrong password. This is the cod I have used:

[/COLOR]Private Sub Workbook_Open()havepass = MsgBox("Do you have High Level Access?", vbYesNo + vbQuestion)
If havepass = vbYes Then
    pword = InputBox("Enter Password")
    If pword = "password" Then
        Sheets("(1) strategic objectives").Visible = True
        'Sheets("Sheet2").Visible = True
        Sheets("(1) strategic objectives").Unprotect ("0000")
        'Sheets("Sheet2").Unprotect ("passwordhere")
        'Sheets("(1) strategic objectives").Activate 'change this to the sheet you want to be active when the correct password is entered.
    Else
        MsgBox ("Incorrect Password")
    End If
  
End If
 
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("(1) strategic objectives").Visible = xlSheetVeryHidden
'Sheets("Sheet2").Visible = xlSheetVeryHidden
Sheets("(1) strategic objectives").Protect Password:="0000"
'Sheets("Sheet2").Protect Password:="passwordhere"
ActiveWorkbook.Save
End Sub


[COLOR=#333333]

Thank you

 

[Scott T]

VBA is case sensitive make sure you match case with what is entered in the code.

 

[nparsons75]

OK, finally I got it working, it was my error... Thank you very much.

Not sure if you can assist with this or not, if not I can open up a new post.

If the password is typed incorrectly, I would like the message to appear, 'please try again' and then have the option to re-enter. Until the user presses cancel. Would this be possible?

finally, if the password is entered correctly then sheet 1 will be shown on open. If no password is pressed then Sheet 1 should also open, again would this be possible.

This is what I tried....

Private Sub Workbook_Open()havepass = MsgBox("Do you have High Level access?", vbYesNo + vbQuestion)
If havepass = vbYes Then
    pword = InputBox("Enter Password")
    If pword = "private" Then
        Sheets("(1) strategic objectives").Visible = True
        Sheets("(2) lead projects").Visible = True
        Sheets("(1) strategic objectives").Unprotect ("private")
        Sheets("(2) lead projects").Unprotect ("private")
        Sheets("menu").Activate 'change this to the sheet you want to be active when the correct password is entered.
    Else
        MsgBox ("Incorect password")
        Sheets("menu").Activate 'change this to the sheet you want to be active when the correct password is entered.
    End If
  End If

It is working perfectly opening the correct sheet after the password is entered.

Again, thank you very much for your help, greatly appreciated.