Loading
Excel.Tips.Net ExcelTips (Menu Interface)

Protecting Individual Worksheets, by User

Excel allows you to protect individual worksheets, as you have learned in other issues of ExcelTips. (You choose Tools | Protection | Protect Sheet.) You can use this approach to protect individual worksheets independently, using different passwords. This means that one user could make changes to one worksheet using one password, and another could use a different password to make changes to the other worksheet.

What if you want to limit access to the worksheets entirely, however? What if you don't even want an unauthorized user to see the other worksheet? This need is a bit trickier to accommodate, but it can be done. The basic approach would be as follows:

  1. Set up a workbook that has three worksheets: One that will always be open, one for user 1, and the third for user 2.
  2. Hide the worksheets for user 1 and user 2.
  3. Create a form that appears whenever the workbook is opened, asking for a user name and password.
  4. Create macro code that unlocks and displays the proper worksheet based on the user name and password.
  5. Protect the entire workbook (Tools | Protection | Protect Workbook).

Steps 1, 2, and 5 are easy enough to do, and have been covered in other issues of ExcelTips. The crux of this approach, however, is steps 3 and 4. You can create a user form by following these steps:

  1. Press Alt+F11 to display the VBA Editor.
  2. In the VBA Editor, choose User Form from the Insert menu. A new, blank user form displays, along with the form toolbox.
  3. Using the controls in the form toolbox, add a TextBox control where the user will enter their user name.
  4. Change the properties for the TextBox control so that its Name is txtUser.
  5. Using the controls in the form toolbox, add a TextBox control where the user will enter their password.
  6. Change the properties for the TextBox control so that its Name is txtPass.
  7. Just under the TextBox controls, add a CommandButton control.
  8. Change the properties for the CommandButton control so its Name is btnOK and its Caption is OK.

With your user form created you are ready to associate macro code with the controls you just placed. Make sure the user form is selected and press F7 to display the Code window for the form. The window may contain a line or two of automatically generated code. Replace this with the following code:

Dim bOK2Use As Boolean

Private Sub btnOK_Click()
    Dim bError As Boolean
    Dim sSName As String
    Dim p As DocumentProperty
    Dim bSetIt As Boolean

    bOK2Use = False
    bError = True
    If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 Then
        bError = False
        Select Case txtUser.Text
            Case "user1"
                sSName = "u1sheet"
                If txtPass.Text <> "u1pass" Then bError = True
            Case "user2"
                sSName = "u2sheet"
                If txtPass.Text <> "u2pass" Then bError = True
            Case Else
                bError = True
        End Select
    End If
    If bError Then
        MsgBox "Invalid User Name or Password"
    Else
        'Set document property
        bSetIt = False
        For Each p In ActiveWorkbook.CustomDocumentProperties
            If p.Name = "auth" Then
                p.Value = sSName
                bSetIt = True
                Exit For
            End If
        Next p
        If Not bSetIt Then
            ActiveWorkbook.CustomDocumentProperties.Add _
              Name:="auth", LinkToContent:=False, _
              Type:=msoPropertyTypeString, Value:=sSName
        End If

        Sheets(sSName).Visible = True
        Sheets(sSName).Unprotect (txtPass.Text)
        Sheets(sSName).Activate

        bOK2Use = True
        Unload UserForm1
    End If
End Sub

Private Sub UserForm_Terminate()
    If Not bOK2Use Then
        ActiveWorkbook.Close (False)
    End If
End Sub

The above code does several things. Notice that there are two procedures: a longer one that runs when the user clicks on the OK button in the form, and another that runs when the form is terminated. When the user clicks on the OK button, the procedure checks to make sure that the combination of the user name and password is correct. If it is not, then the user is notified. If it is, then the authorized sheet name is stored in a document variable and the appropriate sheet is displayed and unprotected.

If you want to change the acceptable user names, sheet names, and passwords, you can do so by making the desired changes in the Select Case structure near the top of this macro code.

The second macro in this code (UserForm_Terminate) comes into play if the user tries to simply dismiss your form without entering a user name and password. In this instance, if the authorization process was not previously completed, then the workbook is simply closed.

In addition to the above code, you will also need to add the following macros to the workbook itself. These open the user form when the workbook is opened, and protect the worksheet when the workbook is closed.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim w As Worksheet
    Dim bSaveIt As Boolean

    bSaveIt = False
    For Each w In Worksheets
        If w.Visible Then
            Select Case w.Name
                Case "u1sheet"
                    w.Protect ("u1pass")
                    w.Visible = False
                    bSaveIt = True
                Case "u2sheet"
                    w.Protect ("u2pass")
                    w.Visible = False
                    bSaveIt = True
            End Select
        End If
    Next w
    If bSaveIt Then
        ActiveWorkbook.CustomDocumentProperties("auth").Delete
        ActiveWorkbook.Save
    End If
End Sub

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "Main" Then
        If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then
            Sh.Visible = False
            MsgBox "You don't have authorization to view that sheet!"
        End If
    End If
End Sub

When the user chooses to close the workbook--they are done with their work--the applicable worksheets are again protected and hidden. (If you change user sheet names and passwords, you will need to change them in the Select Case structure here, as well.) The macro then deletes the appropriate document property and saves the workbook.

Another interesting macro here is the Workbook_SheetActivate procedure. This is included in case where one user tries to use Format | Sheet | Unhide to unhide another user's worksheet. In this case, the user's authorized sheet name (stored in a document variable when the user was originally authorized) is compared to the sheet being displayed. If it doesn't match, then the user isn't allowed to view the worksheet. Note, as well, that this procedure references a worksheet called "Main". This worksheet is the third worksheet mentioned at the beginning of this tip. This worksheet is also the one first displayed when the workbook is opened.

ExcelTips is your source for cost-effective Microsoft Excel training. This tip (1952) applies to Microsoft Excel 97, 2000, 2002, and 2003.

Related Tips:

Excel Smarts for Beginners! Featuring the friendly and trusted For Dummies style, this popular guide shows beginners how to get up and running with Excel while also helping more experienced users get comfortable with the newest features. Check out Excel 2013 For Dummies today!

 

Leave your own comment:

*Name:
Email:
  Notify me about new comments ONLY FOR THIS TIP
Notify me about new comments ANYWHERE ON THIS SITE
Hide my email address
*Text:
*What is 5+3 (To prevent automated submissions and spam.)
 
 
           Commenting Terms

Comments for this tip:

Barry    27 Sep 2016, 05:24
@Louisa,

I'd want to see the code before commenting, but given that you say a Userform pops up (I trust you've not confusing that with the dialog box requesting the user name or password). Then that might indicate the code was in the wrong place, but I am guessing now.
Louisa    26 Sep 2016, 13:57
@Barry

Many thanks for that, I'll have a look when I'm back home! I hate to look a gift horse in the mouth, but any ideas why it wasn't working for me?
Barry    23 Sep 2016, 05:34
@Louisa

You can download the workbook that I used to develop the code using this link: http://bit.ly/2cqcSts. I have made a couple of changes since March but it is ostensibly the same.

The Admin login credentials are username "Baz" & password is "password". This will make all worksheets visible. Other Users are Barry and Buzz both with passwords set to "password".

N.B. as I've noted elsewhere the workbook structure should also be locked, and the macro code password protected.

Once downloaded you'll need to put the workbook into a "trusted" location, otherwise it is likely Excel will not allow macros to run.
Louisa    22 Sep 2016, 07:43
Hi Barry and users,
I'm new to using VB and am on the verge of deciding this project is beyond me, but I would love to get it to work! If you have time, I'd really appreciate your help.
I started with your original code, and then moved to your 14th March code, but have problems with both.
With the original:
1. the workbook opens with all sheets visible.
2. If I run the module in VB (sub btnOK...) I get the userform up, and when I enter username and password and click OK it takes me back into the code (above the first line). Maybe that's OK because the sheets are already open?
3. Should I be able to run the workbook_BeforeClose module? It just asks me for a macroname (and doesn't accept 'workbook_BeforeClose).

With your code of 14th March, again the workbook just opens normally. If I run the code in VB, I get the userform, but when I enter name and password and click OK it just sits there!
As I said, I suspect I'm biting off more than I can chew! Any help very much appreciated, though, I'd love to get it working!! Thanks.
Mosco    18 Sep 2016, 16:30
@Barry

Thanks Barry. I'll have a look at it.
Barry    18 Sep 2016, 05:51
@Mosco

Take a look at this tip: http://excel.tips.net/T002972_Creating_Dependent_Drop-Lists.html
Mosco    17 Sep 2016, 21:51
Data validation

I have a problem with how to select a validated data on one cell so it automatically gives the repond in the adjacent cell.

For instance, I have a list of Food categories in a cell column all valiadted. On the adjacent cell I have the name of foods.

So, on the Food column when I selected Fruits from the drop down list, on the adjacent cell I want the cell to have a drop list of all the fruits I want (I will include them in the validation list) and so on. When I click vegetables on the Food column, the adjacent cell of it should automatically have a list of all the vegetables.

I only know how to validate a cell only. Please can someone help with this.
Barry    17 Sep 2016, 09:50
@Omar,

Sorry it was 14th not 16th.

Note: the protection of the workbook structure hasn't been coded.

Making specified sheets read only on a per User basis is possible but requires some restructuring/re-coding of the way the macros work.I think having sheet names in Row 1 and then against each User either "R" or "RW" to indicate whether a sheet is visible read-only or visible without restriction respectively is the way to go.
Omar    16 Sep 2016, 12:53
@Barry,

I did find the code, created a new file and tested it. It works like a charm.

Now the next question is, how can I restrict some users to "read-only" a particular sheet? Thanks
Omar    16 Sep 2016, 08:41
@Barry,

I was using your original post code, with the macros. I could take advantage of a better way of doing it, but I can't see the posting from 16th of March. Were you talking about the one from the 14th?

Thanks for the help.
Barry    16 Sep 2016, 05:31
@Omar,

I do not know what code you are basing your project on as there are several mentioned in this thread - it would be useful to know which. Unless you've done some other changes the sSName variable can only hold a single value and the supporting code is geared to use it that way. It could be possible to create an array and for supporting code to deal with, but I suggest you use the code given on 16th March 2016, it is structured in a different way using a hidden worksheet to hold the list of Users, their passwords and the sheets they are permitted to view. This is much easier to maintain than having to delve into the macro code each their is new User or a change to an existing Users permissions.

Secondly, using InnputBox doesn't allow the masking of password input. This can be done using a Userform with TextBox's.
Omar    15 Sep 2016, 14:51
Also, how can we hide the password from the box while opening the file?
Omar    15 Sep 2016, 14:43
I need help allowing and admin to open all sheets in the workbook. Here is where I'm having problems:

Select Case txtUser.Text
            Case "adminuser"
                sSName = "master","u1sheet","u2sheet"
                If txtPass.Text <> "adminpass" Then bError = True

I don't think I can call different sheets in the same case, can I?
Jay    31 Aug 2016, 08:41
Barry, Thanks for the tip!

Instead of calling the showallsheets sub I called the workbook_open() and it seems to be working!

Not bad for an old hack like me LOL!

Summary:

I have modified Barry's code that verifies access to the spreadsheet based on the user logged into the machine to include a force use of macro in order to open the workbook.

I will continue to test this code and post as new issues arise.
Barry    31 Aug 2016, 05:06
@Jay,

I've only had a chance to have a quick look, you don't say if this happens all every time a User changes a cell value and saves the workbook?

I can see towards the end of the "CustomSave" sub-routine that you call the ShowAllSheets irrespective of the User's privileges. You quite rightly hide all the sheets before the save, but you must only unhide the sheets after the save that a User has the privilege to view.

In my original code this was in the "Workbook_AfterSave" sub-routine and is very much a repeat of the code in the Workbook_Open routine which determines what sheets a user can see.

I might have missed some subtlety in your code, though.

The other possible reason is a run-time error this can cause the early exit of a sub-routine possibly, therefore, leaving sheets visible that shouldn't be. This is most likely to happen sometime after the ShowAllSheets sub-routine is run. This routine should not be used unnecessarily, and therefore only once Admin rights have been established or re-established after a save operation.

I hope this helps.
jay    29 Aug 2016, 11:47
Second half:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

     'Declare the variable
     Dim Ans As Integer
     
     'If the workbook's Saved property is False, emulate Excel's default save prompt
     If Me.Saved = False Then
         Do
             Ans = MsgBox("Do you want to save the changes you made to '" & _
                 Me.Name & "'?", vbQuestion + vbYesNoCancel)
             Select Case Ans
                 Case vbYes
                     Call CustomSave
                 Case vbNo
                     Me.Saved = True
                 Case vbCancel
                     Cancel = True
                     Exit Sub
             End Select
         Loop Until Me.Saved
     End If
     
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

     'Cancel regular saving
     Cancel = True
     
     'Call the CustomSave routine
     Call CustomSave(SaveAsUI)
     
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)

     'Declare the variables
     Dim ActiveSht As Object
     Dim FileFormat As Variant
     Dim FileName As String
     Dim FileFilter As String
     Dim FilterIndex As Integer
     Dim Msg As String
     Dim Ans As Integer
     Dim OrigSaved As Boolean
     Dim WorkbookSaved As Boolean
     
     'Turn off screen updating
     Application.ScreenUpdating = False
     
     'Turn off events so that the BeforeSave event doesn't occur
     Application.EnableEvents = False
     
     'Assign the status of the workbook's Saved property to a variable
     OrigSaved = Me.Saved
     
     'Assign the active sheet to an object variable
     Set ActiveSht = ActiveSheet
     
     'Call the HideAllSheets routine
     Call HideAllSheets
     
     'Save workbook or prompt for SaveAs filename
     If SaveAs Or Len(Me.Path) = 0 Then
         If Val(Application.Version) < 12 Then
             FileFilter = "Microsoft Office Excel Workbook (*.xls), *.xls"
             FilterIndex = 1
         Else
             FileFilter = "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm, " & _
                 "Excel 97-2003 Workbook (*.xls), *.xls"
             If Right(Me.Name, 4) = ".xls" Then
                 FilterIndex = 2
             Else
                 FilterIndex = 1
             End If
         End If
         Do
             FileName = Application.GetSaveAsFilename( _
                 InitialFileName:=Me.Name, _
                 FileFilter:=FileFilter, _
                 FilterIndex:=FilterIndex, _
                 Title:="SaveAs")
             If FileName = "False" Then Exit Do
             If IsLegalFilename(FileName) = False Then
                 Msg = "The file name is invalid. Try one of the "
                 Msg = Msg & "following:" & vbCrLf & vbCrLf
                 Msg = Msg & Chr(149) & " Make sure that the file name "
                 Msg = Msg & "does not contain any" & vbCrLf
                 Msg = Msg & " of the following characters: "
                 Msg = Msg & "< > ? [ ] : | or *" & vbCrLf
                 Msg = Msg & Chr(149) & " Make sure that the file/path "
                 Msg = Msg & "name does not exceed" & vbCrLf
                 Msg = Msg & " more than 218 characters."
                 MsgBox Msg, vbExclamation, "Invalid File Name"
             Else
                 If Val(Application.Version) < 12 Then
                     FileFormat = -4143
                 Else
                     If Right(FileName, 4) = ".xls" Then
                         FileFormat = 56
                     Else
                         FileFormat = 52
                     End If
                 End If
                 If Len(Dir(FileName)) = 0 Then
                     Application.DisplayAlerts = False
                     Me.SaveAs FileName, FileFormat
                     Application.DisplayAlerts = True
                     WorkbookSaved = True
                 Else
                     Ans = MsgBox("'" & FileName & "' already exists. " & _
                         "Do you want to replace it?", vbQuestion + vbYesNo, _
                         "Confirm Save As")
                     If Ans = vbYes Then
                         Application.DisplayAlerts = False
                         Me.SaveAs FileName, FileFormat
                         Application.DisplayAlerts = True
                         WorkbookSaved = True
                     End If
                 End If
             End If
         Loop Until Me.Saved
     Else
         Application.DisplayAlerts = False
         Me.Save
         Application.DisplayAlerts = True
         WorkbookSaved = True
     End If
     
     'Call the ShowAllSheets routine
     Call ShowAllSheets
     
     'Activate the prior active sheet
     ActiveSht.Activate
     
     'Set the workbook's Saved property
     If WorkbookSaved Then
         Me.Saved = True
     Else
         Me.Saved = OrigSaved
     End If
     
     'Turn on screen updating
     Application.ScreenUpdating = True
     
     'Turn on events
     Application.EnableEvents = True
     
End Sub



Private Function IsLegalFilename(ByVal fname As String) As Boolean
     Dim BadChars As Variant
     Dim i As Long
     If Len(fname) > 218 Then
         IsLegalFilename = False
         Exit Function
     Else
         BadChars = Array("\", "/", "<", ">", "?", "[", "]", ":", "|", "*", """")
         fname = GetFileName(fname)
         For i = LBound(BadChars) To UBound(BadChars)
             If InStr(1, fname, BadChars(i)) > 0 Then
                 IsLegalFilename = False
                 Exit Function
             End If
         Next i
     End If
     IsLegalFilename = True
End Function

Private Function GetFileName(ByVal FullName As String) As String
     Dim i As Long
     For i = Len(FullName) To 1 Step -1
         If Mid(FullName, i, 1) = Application.PathSeparator Then Exit For
     Next i
     GetFileName = Mid(FullName, i + 1)
End Function
jay    29 Aug 2016, 11:46
First half of code:

'Force the explicit declaration of variables
Option Explicit

'Assign the name of the warning sheet to a constant
Const warning As String = "Warning"

Private Sub HideAllSheets()

     'Declare the variable
     Dim Sh As Object
     
     'Display the warning sheet
     Sheets(warning).Visible = xlSheetVisible
     
     'Hide every sheet, except the warning sheet
     For Each Sh In Sheets
         If Sh.Name <> warning Then
             Sh.Visible = xlSheetVeryHidden
         End If
     Next Sh
     
End Sub

Private Sub ShowAllSheets()

     'Declare the variable
     Dim Sh As Object
     
     'Display every sheet, except the warning sheet
     For Each Sh In Sheets
         If Sh.Name <> warning Then
             Sh.Visible = xlSheetVisible
         End If
     Next Sh
     
     'Hide the warning sheet
     Sheets(warning).Visible = xlSheetVeryHidden
     
End Sub

Private Sub Workbook_Open()

     'Turn off screen updating
     Application.ScreenUpdating = False
     
     'Call the ShowAllSheets routine
     'Call ShowAllSheets
     
     'Set the workbook's Saved property to True
     Me.Saved = True
     
     'Turn on screen updating
     Application.ScreenUpdating = True


    Dim Sh As Integer, c As Integer
    Dim rng As Range
    Dim UsersName As String, ws As String
    Dim m As Variant
    Dim wsUsers As Worksheet
    
    
    Set wsUsers = Worksheets("Users")
    Set rng = wsUsers.Range(wsUsers.Range("A1"), wsUsers.Range("A" & wsUsers.Rows.Count).End(xlUp))
    
    UsersName = Environ("USERNAME")
    
    m = Application.Match(UsersName, rng, False)
    
    On Error GoTo myerror
    If Not IsError(m) Then
        If CBool(wsUsers.Cells(Val(m), 2).Value) Then
        'admin user
        For Sh = 2 To Worksheets.Count
            Worksheets(Sh).Visible = xlSheetVisible
        Next Sh
        
        'Hide the warning sheet
            Sheets(warning).Visible = xlSheetVeryHidden
        
        Else
        'show users sheet(s)
        c = 3
        Do
            ws = CStr(wsUsers.Cells(Val(m), c).Text)
            If Len(ws) = 0 Then Exit Do
            Worksheets(ws).Visible = xlSheetVisible
            c = c + 1
        Loop
        
        'Hide the warning sheet
            Sheets(warning).Visible = xlSheetVeryHidden
        
        End If
        
    Else
    
        MsgBox "You Do Not Have Authorized Access To This Workbook.", 16, "No Access"
        
        Workbooks("2016 Sales Forecast by Barry2.XLSM").Close SaveChanges:=False
        
    End If
    
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"

     
End Sub
Jay    29 Aug 2016, 11:45
trying to repaste my most updated code and getting errors, will try again later...
Jay    29 Aug 2016, 11:12
Hi! Barry, my code is below. I am getting some unexpected unlocking of all sheets with a user that is not an admin when they change a cell value and save the workbook. Any help would be appreciated!

P.S. - I did make some modifications to the original that others may find helpful: I forced use of macro in order to open the workbook

'Force the explicit declaration of variables
Option Explicit

'Assign the name of the warning sheet to a constant
Const Warning As String = "Warning"

Private Sub Workbook_Open()

     'Turn off screen updating
     Application.ScreenUpdating = False
     
     'Call the ShowAllSheets routine
     Call ShowAllSheets
     
     'Set the workbook's Saved property to True
     Me.Saved = True
     
     'Turn on screen updating
     Application.ScreenUpdating = True


    Dim Sh As Integer, c As Integer
    Dim rng As Range
    Dim UsersName As String, ws As String
    Dim m As Variant
    Dim wsUsers As Worksheet
    
    
    Set wsUsers = Worksheets("Users")
    Set rng = wsUsers.Range(wsUsers.Range("A1"), wsUsers.Range("A" & wsUsers.Rows.Count).End(xlUp))
    
    UsersName = Environ("USERNAME")
    
    m = Application.Match(UsersName, rng, False)
    
    On Error GoTo myerror
    If Not IsError(m) Then
        If CBool(wsUsers.Cells(Val(m), 2).Value) Then
        'admin user
        For Sh = 2 To Worksheets.Count
            Worksheets(Sh).Visible = xlSheetVisible
        Next Sh
        
        Else
        'show users sheet(s)
        c = 3
        Do
            ws = CStr(wsUsers.Cells(Val(m), c).Text)
            If Len(ws) = 0 Then Exit Do
            Worksheets(ws).Visible = xlSheetVisible
            c = c + 1
        Loop
        
        End If
        
    Else
    
        MsgBox "You Do Not Have Authorised Access To This Workbook.", 16, "No Access"
        
    End If
    
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"

     
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

     'Declare the variable
     Dim Ans As Integer
     
     'If the workbook's Saved property is False, emulate Excel's default save prompt
     If Me.Saved = False Then
         Do
             Ans = MsgBox("Do you want to save the changes you made to '" & _
                 Me.Name & "'?", vbQuestion + vbYesNoCancel)
             Select Case Ans
                 Case vbYes
                     Call CustomSave
                 Case vbNo
                     Me.Saved = True
                 Case vbCancel
                     Cancel = True
                     Exit Sub
             End Select
         Loop Until Me.Saved
     End If
     
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

     'Cancel regular saving
     Cancel = True
     
     'Call the CustomSave routine
     Call CustomSave(SaveAsUI)
     
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)

     'Declare the variables
     Dim ActiveSht As Object
     Dim FileFormat As Variant
     Dim FileName As String
     Dim FileFilter As String
     Dim FilterIndex As Integer
     Dim Msg As String
     Dim Ans As Integer
     Dim OrigSaved As Boolean
     Dim WorkbookSaved As Boolean
     
     'Turn off screen updating
     Application.ScreenUpdating = False
     
     'Turn off events so that the BeforeSave event doesn't occur
     Application.EnableEvents = False
     
     'Assign the status of the workbook's Saved property to a variable
     OrigSaved = Me.Saved
     
     'Assign the active sheet to an object variable
     Set ActiveSht = ActiveSheet
     
     'Call the HideAllSheets routine
     Call HideAllSheets
     
     'Save workbook or prompt for SaveAs filename
     If SaveAs Or Len(Me.Path) = 0 Then
         If Val(Application.Version) < 12 Then
             FileFilter = "Microsoft Office Excel Workbook (*.xls), *.xls"
             FilterIndex = 1
         Else
             FileFilter = "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm, " & _
                 "Excel 97-2003 Workbook (*.xls), *.xls"
             If Right(Me.Name, 4) = ".xls" Then
                 FilterIndex = 2
             Else
                 FilterIndex = 1
             End If
         End If
         Do
             FileName = Application.GetSaveAsFilename( _
                 InitialFileName:=Me.Name, _
                 FileFilter:=FileFilter, _
                 FilterIndex:=FilterIndex, _
                 Title:="SaveAs")
             If FileName = "False" Then Exit Do
             If IsLegalFilename(FileName) = False Then
                 Msg = "The file name is invalid. Try one of the "
                 Msg = Msg & "following:" & vbCrLf & vbCrLf
                 Msg = Msg & Chr(149) & " Make sure that the file name "
                 Msg = Msg & "does not contain any" & vbCrLf
                 Msg = Msg & " of the following characters: "
                 Msg = Msg & "< > ? [ ] : | or *" & vbCrLf
                 Msg = Msg & Chr(149) & " Make sure that the file/path "
                 Msg = Msg & "name does not exceed" & vbCrLf
                 Msg = Msg & " more than 218 characters."
                 MsgBox Msg, vbExclamation, "Invalid File Name"
             Else
                 If Val(Application.Version) < 12 Then
                     FileFormat = -4143
                 Else
                     If Right(FileName, 4) = ".xls" Then
                         FileFormat = 56
                     Else
                         FileFormat = 52
                     End If
                 End If
                 If Len(Dir(FileName)) = 0 Then
                     Application.DisplayAlerts = False
                     Me.SaveAs FileName, FileFormat
                     Application.DisplayAlerts = True
                     WorkbookSaved = True
                 Else
                     Ans = MsgBox("'" & FileName & "' already exists. " & _
                         "Do you want to replace it?", vbQuestion + vbYesNo, _
                         "Confirm Save As")
                     If Ans = vbYes Then
                         Application.DisplayAlerts = False
                         Me.SaveAs FileName, FileFormat
                         Application.DisplayAlerts = True
                         WorkbookSaved = True
                     End If
                 End If
             End If
         Loop Until Me.Saved
     Else
         Application.DisplayAlerts = False
         Me.Save
         Application.DisplayAlerts = True
         WorkbookSaved = True
     End If
     
     'Call the ShowAllSheets routine
     Call ShowAllSheets
     
     'Activate the prior active sheet
     ActiveSht.Activate
     
     'Set the workbook's Saved property
     If WorkbookSaved Then
         Me.Saved = True
     Else
         Me.Saved = OrigSaved
     End If
     
     'Turn on screen updating
     Application.ScreenUpdating = True
     
     'Turn on events
     Application.EnableEvents = True
     
End Sub

Private Sub HideAllSheets()

     'Declare the variable
     Dim Sh As Object
     
     'Display the warning sheet
     Sheets(Warning).Visible = xlSheetVisible
     
     'Hide every sheet, except the warning sheet
     For Each Sh In Sheets
         If Sh.Name <> Warning Then
             Sh.Visible = xlSheetVeryHidden
         End If
     Next Sh
     
End Sub

Private Sub ShowAllSheets()

     'Declare the variable
     Dim Sh As Object
     
     'Display every sheet, except the warning sheet
     For Each Sh In Sheets
         If Sh.Name <> Warning Then
             Sh.Visible = xlSheetVisible
         End If
     Next Sh
     
     'Hide the warning sheet
     Sheets(Warning).Visible = xlSheetVeryHidden
     
End Sub

Private Function IsLegalFilename(ByVal fname As String) As Boolean
     Dim BadChars As Variant
     Dim i As Long
     If Len(fname) > 218 Then
         IsLegalFilename = False
         Exit Function
     Else
         BadChars = Array("\", "/", "<", ">", "?", "[", "]", ":", "|", "*", """")
         fname = GetFileName(fname)
         For i = LBound(BadChars) To UBound(BadChars)
             If InStr(1, fname, BadChars(i)) > 0 Then
                 IsLegalFilename = False
                 Exit Function
             End If
         Next i
     End If
     IsLegalFilename = True
End Function

Private Function GetFileName(ByVal FullName As String) As String
     Dim i As Long
     For i = Len(FullName) To 1 Step -1
         If Mid(FullName, i, 1) = Application.PathSeparator Then Exit For
     Next i
     GetFileName = Mid(FullName, i + 1)
End Function





Barry    29 Aug 2016, 06:29
@Jonathan,

The code works by storing the name of the Worksheet that the user has permission to view in a custom document properties value. The macro will give the error message if a user activates any other sheet which will have a different name (unless it is called "Main"). This could also cause a problem if the user changed the worksheet name also unless the structure is protected.

The macro was not written to cope with there being additional sheets which would not be restricted by user.

This fairly fundamental to how the whole macro operates, and I would suggest that the code be re-written to take this into account. The other set of code mentioned in this article would allow the other sheets to be permitted by user.

You could as a quick fix create a list of permitted worksheets that any user can view using this code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Select Case Sh.Name
           Case "Main", "AllowedSheet1", "AllowedSheet2",..... 'add unrestricted sheet names to this list
           Case Else
                     If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then
                              Sh.Visible = False
                              MsgBox "You don't have authorisation to view that sheet!"
                     End If
    End Select
End Sub

substitute the names of unrestricted worksheets for "AllowedSheet1", "AllowedSheet2",.....
Jonathan    29 Aug 2016, 06:24
@ Barry

Sorted. Realised I had to edit both macros to match names and passwords etc!

Just starting out in this so takes a bit of getting the hang of it!
Jonathan    27 Aug 2016, 06:06
@ barry

code in UserForm:
Dim bOK2Use As Boolean

Private Sub btnOK_Click()
    Dim bError As Boolean
    Dim sSName As String
    Dim p As DocumentProperty
    Dim bSetIt As Boolean

    bOK2Use = False
    bError = True
    If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 Then
        bError = False
        Select Case txtUser.Text
            Case "jdh"
                sSName = "JDH"
                If txtPass.Text <> "jdh" Then bError = True
            Case "user2"
                sSName = "u2sheet"
                If txtPass.Text <> "u2pass" Then bError = True
            Case Else
                bError = True
        End Select
    End If
    If bError Then
        MsgBox "Invalid User Name or Password"
    Else
        'Set document property
        bSetIt = False
        For Each p In ActiveWorkbook.CustomDocumentProperties
            If p.Name = "auth" Then
                p.Value = sSName
                bSetIt = True
                Exit For
            End If
        Next p
        If Not bSetIt Then
            ActiveWorkbook.CustomDocumentProperties.Add _
              Name:="auth", LinkToContent:=False, _
              Type:=msoPropertyTypeString, Value:=sSName
        End If

        Sheets(sSName).Visible = True
        Sheets(sSName).Unprotect (txtPass.Text)
        Sheets(sSName).Activate

        bOK2Use = True
        Unload UserForm1
    End If
End Sub

Private Sub UserForm_Terminate()
    If Not bOK2Use Then
        ActiveWorkbook.Close (False)
    End If
End Sub

Code in This Workbook:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim w As Worksheet
    Dim bSaveIt As Boolean

    bSaveIt = False
    For Each w In Worksheets
        If w.Visible Then
            Select Case w.Name
                Case "u1sheet"
                    w.Protect ("u1pass")
                    w.Visible = False
                    bSaveIt = True
                Case "u2sheet"
                    w.Protect ("u2pass")
                    w.Visible = False
                    bSaveIt = True
            End Select
        End If
    Next w
    If bSaveIt Then
        ActiveWorkbook.CustomDocumentProperties("auth").Delete
        ActiveWorkbook.Save
    End If
End Sub

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "Main" Then
        If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then
            Sh.Visible = False
            MsgBox "You don't have authorization to view that sheet!"
        End If
    End If
End Sub
Jonathan    27 Aug 2016, 05:40
I was using the code direct from the 'Tip'. The only change I made was to the user and sheet names.
Barry    26 Aug 2016, 11:06
@Jonathan,

Difficult to answer your question without seeing your code.
Jonathan    25 Aug 2016, 14:28
Having followed the basic setup all appears to work revealing the hidden sheet for the user, however the sheets that are not hidden, when clicked on say "You don't have authorisation to view that sheet!"

Can anyone advise where I might have gone wrong?
Barry    05 Aug 2016, 05:26
@Ankur

Your question:
1. is there a way to restrict a user without admin right(as defined in user sheet) to view code in VBA by pressing alt+F11?

Yes in the VBE go to Tools -> VBAProjectProperties then select the "Protection" tab where you can lock the project from being viewed and set a password to unlock this. Then "Save" the project.

NB the password protection isn't very strong, and there are lots of cracks on the web if someone is keen enough to want to break into the code.

I would strongly advise also protecting the structure of the workbookso that users cannot delete sheets, for instance.
Ankur    04 Aug 2016, 07:48
Hi barry,
i had used your code which is below:
Option Explicit
Dim m As Variant
Dim shtCurrent As Worksheet

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    Dim wsUsers As Worksheet
    Dim sh As Integer, c As Integer
    Dim ws As String
    
    Set wsUsers = Worksheets("Users")
    If m = 0 Then Exit Sub
    If CBool(wsUsers.Cells(Val(m), 3).Value) = True Then
        'admin user
        For sh = 1 To Worksheets.Count
            Worksheets(sh).Visible = xlSheetVisible
        Next sh
    Else
        'show users sheet(s)
        c = 4
        On Error Resume Next
        Do
            ws = CStr(wsUsers.Cells(Val(m), c).Text)
            If Len(ws) = 0 Then Exit Do
            Worksheets(ws).Visible = xlSheetVisible
            c = c + 1
        Loop
    End If
    
    shtCurrent.Activate
    
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim sh As Integer
    
    Set shtCurrent = ActiveSheet
    
    For sh = 1 To Worksheets.Count
        If Worksheets(sh).Name = "Home" Then
            Worksheets(sh).Visible = xlSheetVisible
        Else
            Worksheets(sh).Visible = xlSheetVeryHidden
        End If
    Next sh
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Workbook_BeforeClose False
End Sub

Private Sub Workbook_Open()
    Dim sh As Integer, c As Integer
    Dim rng As Range
    Dim UsersName As String, pw As String, ws As String
    Dim wsUsers As Worksheet
    
    'hide all but sheet named "Home"
    For sh = 1 To Worksheets.Count
        If Worksheets(sh).Name = "Home" Then
            Worksheets(sh).Visible = xlSheetVisible
        Else
            Worksheets(sh).Visible = xlSheetVeryHidden
        End If
    Next sh
    
    Set wsUsers = Worksheets("Users")
    Set rng = wsUsers.Range(wsUsers.Range("A1"), wsUsers.Range("A" & wsUsers.Rows.Count).End(xlUp))
    
    'Get Username and password and validate
    Do
        UsersName = InputBox("Enter your Username?", "Username")
        If UsersName = "" Then Exit Sub
        m = Application.Match(UsersName, rng, False)
        If IsError(m) Then
            UsersName = ""
            MsgBox "Invalid Name!", vbCritical + vbOKOnly, "Usersname"
        End If
    Loop Until UsersName <> ""
    Do
        pw = InputBox("Enter your password?", "User - " & UsersName)
        If pw = "" Then Exit Sub
        If pw <> wsUsers.Cells(Val(m), 2) Then
            pw = ""
            MsgBox "Incorrect password!", vbCritical + vbOKOnly, "User - " & UsersName
        End If
    Loop Until pw <> ""
    
    On Error GoTo myerror
    If Not IsError(m) Then
        If CBool(wsUsers.Cells(Val(m), 3).Value) Then
            'admin user
           For sh = 1 To Worksheets.Count
                Worksheets(sh).Visible = xlSheetVisible
            Next sh
        Else
            'show users sheet(s)
            c = 4
            On Error Resume Next
            Do
                ws = CStr(wsUsers.Cells(Val(m), c).Text)
                If Len(ws) = 0 Then Exit Do
                Worksheets(ws).Visible = xlSheetVisible
                c = c + 1
            Loop
        End If
    Else
    
        MsgBox "You Do Not Have Authorised Access To This Workbook.", 16, "No Access"
        
    End If
Exit Sub

myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub


I need your help with below doubt:
1. is there a way to restrict a user without admin right(as defined in user sheet) to view code in VBA by pressing alt+F11?
BARRY    23 Jul 2016, 00:41
@Jenna

The code should be placed on the "ThisWorkbook" code page.

Workbook_Open, Workbook_Close, etc will not work unless posted on the "ThisWorkbook" code page.
Jenna    21 Jul 2016, 11:18
When you say, "to add the following macros to the workbook itself," do you mean into a module? I'm having a little but of confusion with this.
Barry    19 Jul 2016, 05:48
@Jay,

It almost certainly due to the value being stored at wsUsers.Cells(Val(m), 3).Value evaluates to be non-numeric.The value in the Admin Rights column should be True, False or blank.
Jay    18 Jul 2016, 15:04
I usually figure it out if left to my own devices...

I suppose this error was due to an incorrect entry of my actual username!

I was able to find the correct one by going to c:\Users to determine what my actual username should be!
Jay    18 Jul 2016, 13:17
It keeps bugging out on this line of code:

If CBool(wsUsers.Cells(Val(m), 3).Value) = True Then
Jay    18 Jul 2016, 13:08
Barry-

Getting a "type-mismatch" error when running code dated Mar 14,

Any insight?
Barry    16 Jul 2016, 11:32
@ankur

You're not giving us much to go on.

What code are you using? (there are several versions in this thread)
Have you placed in the correct modules? (most need to be on the "ThisWorkbook" codepage)
Are you getting any error messages? if what are they and at what line in the code are they occurring?
Are there any other symptoms?
Are macros enabled? (nothing is going to happen if Excel doesn't allow them to run)
ankur    15 Jul 2016, 05:35
Hi,

I need some help. i tried using the code but it is not working and i can't even see the form on opening the file.

Please help.
Barry    07 Jul 2016, 10:25
@Andrew,

There are two fundamentally different sets of code in this tip. The comments I have made that you quote relate to the code I put forward in March 2016, which utilises another worksheet to hold a list of valid users, their passwords, Admin rights, and a list of worksheets each user is permitted to view. In column "A" is the users name, column "B" is their password, Column "C" whether they are administrators (TRUE) or not (FALSE), then column "D", "E", "F",...& onwards the TabName of each sheet that user is permitted to access.

Jo's code has this information embedded in the VBA code itself/custom properties field of the Workbook.

You must use one set of code or the other, you cannot mix and match.

@Emma

I haven't tried it in Excel 2013 but I've no reason to believe that it wouldn't work.
Emma    06 Jul 2016, 09:44
Does this work on excel 2013?
Andrew    05 Jul 2016, 21:18
Hello,
Thank you for the code, it is working really good but the only thing I don't get how to let a user have multiple sheets? since jo was overwriting the sSName so it will not work but how to let sSName be a several sheets? I didn't understand what barry said "You just have to put the name of each worksheet you want to be visible for a particular User in adjacent columns in the row on the "Users" page for each User."
please help.
Thanks
Jo    02 Jun 2016, 14:08
Kerry is Burt. Sorry
Jo    02 Jun 2016, 14:07
I know very little about macros. Can someone help me fix this. I want one spreadsheet to be visible to each person except Kerry. I want him to see all sheets. Please help me fix. Thanks.

Dim bOK2Use As Boolean

Private Sub btnOK_Click()
    Dim bError As Boolean
    Dim sSName As String
    Dim p As DocumentProperty
    Dim bSetIt As Boolean

    bOK2Use = False
    bError = True
    If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 Then
        bError = False
        Select Case txtUser.Text
            Case "Elmo"
                sSName = "Elmo"
                If txtPass.Text <> "Elmo1" Then bError = True
            Case "Bird"
                sSName = "Bird"
                If txtPass.Text <> "Bird2" Then bError = True
            Case "Cookie"
                sSName = "Cookie"
                If txtPass.Text <> "Cookie3" Then bError = True
            Case "Burt"
                sSName = "Elmo"
                sSName = "Bird"
                sSName = "Cookie"
                sSName = "Burt"
                sSName = "Summary"
                If txtPass.Text <> "Burt4" Then bError = True
            Case Else
                bError = True
        End Select
    End If
    If bError Then
        MsgBox "Invalid User Name or Password"
    Else
        'Set document property
        bSetIt = False
        For Each p In ActiveWorkbook.CustomDocumentProperties
            If p.Name = "auth" Then
                p.Value = sSName
                bSetIt = True
                Exit For
            End If
        Next p
        If Not bSetIt Then
            ActiveWorkbook.CustomDocumentProperties.Add _
              Name:="auth", LinkToContent:=False, _
              Type:=msoPropertyTypeString, Value:=sSName
        End If

        Sheets(sSName).Visible = True
        Sheets(sSName).Activate

        bOK2Use = True
        Unload LogIn
    End If
End Sub

Private Sub Userform_Terminate()
    If Not bOK2Use Then
        ActiveWorkbook.Close (False)
    End If
End Sub


Barry    05 May 2016, 05:38
@Nick,

You just have to put the name of each worksheet you want to be visible for a particular User in adjacent columns in the row on the "Users" page for each User.

NB this is only applicable to the code I have given.
Nick    04 May 2016, 06:20
This code is working really well for my tests before I implement it, but I am struggling to create a section for the code to allow several sheets to to open when a user enters their credentials, but not all of them. Any hints or tips for this? for example, if user one entered their details, they can see sheet 1 and sheet 2, but when user 2 opens it, they can only see sheet 2?

thank you for your help!

Nick
Barry    26 Mar 2016, 06:50
The code I have suggested doesn't use the Custome Properties and therefore trying to access these with the ActiveWorkbook.CustomDocumentProperties("auth").Value function will result is and error.

If you've used the code in the main tip then these "customproperties" maybe present but could give rise to other errors.

Although I advocate the re-use of code it has to be done in the full knowledge of how the routines interact.My suggested code doesn't use the customproperties and ignores it if present.

I suggest using the code suggested by me on either 14th March 2016 or 1 February 2016

Please note the caveats with the suggested code i.e. I haven't coded the protection of the workbook structure.
Tim    25 Mar 2016, 17:57
Update: I tried starting from scratch to eliminate any silly errors/oversights, and using the userform code recommended by Barry I am still getting a runtime error after I enter a correct user/pswd combo and attempt to click on a different sheet...this time '5': invalid procedure or argument.

VBA again highlights the same piece of workbook code dealing with sheetactivate, but this time the specific line is :
If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then


I expect this will only make finding a solution more difficult, but wanted to be detailed and clear with what I've been running into.

Tim    25 Mar 2016, 16:58
This procedure is exactly what I would like to accomplish, however, the code is not working for me.

I encountered the exact same bug that Lucy did below (3/9/2016). I tried changing the code for the userform to what Jurie recommended on 3/10/2016. This eliminated the previous bug, but introduced a new one. Now after I enter a correct user/pswd combo the dialog box disappears and nothing happens unless I attempt to select the appropriate sheet (or any sheet for that matter). At this point I get Run-time error '1004': Unable to set the Visible property of the worksheet class, and all the sheets go hidden. Strangely enough I can manually unhide all of the sheets at this point as the code seems to have failed.

VBA highlights the Sh.Visible = False line of this Sub from the workbook code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "Main" Then
        If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then
            Sh.Visible = False
            MsgBox "You don't have authorization to view that sheet!"
        End If
    End If
End Sub


I hope this is clear and someone can steer me in the right direction. I have ensured that my SsName's correspond to the proper sheet names as barry suggested in regards to the initial bug lucy encountered, but I am not sure how to confirm that sSname is identifying the right sheet...not to mention I am not convinced my issue is related to this.
Jurie    15 Mar 2016, 05:05
Thanx Barry, I do appreciate your input. I will certainly look at this at some point and if I should have a problem, I'll be sure to get back to you. Thanx again.
Barry    14 Mar 2016, 08:24
@Jurie,

The following code introduces a password as the second column on the Users worksheet. It's implemented using the InputBox function which doesn't have a facility for masking the password as it is inputted, a better solution would be to use a Userform as text boxes do have this as an option.

Option Explicit
Dim m As Variant
Dim shtCurrent As Worksheet

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    Dim wsUsers As Worksheet
    Dim sh As Integer, c As Integer
    Dim ws As String
    
    Set wsUsers = Worksheets("Users")
    If m = 0 Then Exit Sub
    If CBool(wsUsers.Cells(Val(m), 3).Value) = True Then
        'admin user
        For sh = 1 To Worksheets.Count
            Worksheets(sh).Visible = xlSheetVisible
        Next sh
    Else
        'show users sheet(s)
        c = 4
        On Error Resume Next
        Do
            ws = CStr(wsUsers.Cells(Val(m), c).Text)
            If Len(ws) = 0 Then Exit Do
            Worksheets(ws).Visible = xlSheetVisible
            c = c + 1
        Loop
    End If
    
    shtCurrent.Activate
    
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim sh As Integer
    
    Set shtCurrent = ActiveSheet
    
    For sh = 1 To Worksheets.Count
        If Worksheets(sh).Name = "Home" Then
            Worksheets(sh).Visible = xlSheetVisible
        Else
            Worksheets(sh).Visible = xlSheetVeryHidden
        End If
    Next sh
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Workbook_BeforeClose False
End Sub

Private Sub Workbook_Open()
    Dim sh As Integer, c As Integer
    Dim rng As Range
    Dim UsersName As String, pw As String, ws As String
    Dim wsUsers As Worksheet
    
    'hide all but sheet named "Home"
    For sh = 1 To Worksheets.Count
        If Worksheets(sh).Name = "Home" Then
            Worksheets(sh).Visible = xlSheetVisible
        Else
            Worksheets(sh).Visible = xlSheetVeryHidden
        End If
    Next sh
    
    Set wsUsers = Worksheets("Users")
    Set rng = wsUsers.Range(wsUsers.Range("A1"), wsUsers.Range("A" & wsUsers.Rows.Count).End(xlUp))
    
    'Get Username and password and validate
    Do
        UsersName = InputBox("Enter your Username?", "Username")
        If UsersName = "" Then Exit Sub
        m = Application.Match(UsersName, rng, False)
        If IsError(m) Then
            UsersName = ""
            MsgBox "Invalid Name!", vbCritical + vbOKOnly, "Usersname"
        End If
    Loop Until UsersName <> ""
    Do
        pw = InputBox("Enter your password?", "User - " & UsersName)
        If pw = "" Then Exit Sub
        If pw <> wsUsers.Cells(Val(m), 2) Then
            pw = ""
            MsgBox "Incorrect password!", vbCritical + vbOKOnly, "User - " & UsersName
        End If
    Loop Until pw <> ""
    
    On Error GoTo myerror
    If Not IsError(m) Then
        If CBool(wsUsers.Cells(Val(m), 3).Value) Then
            'admin user
            For sh = 1 To Worksheets.Count
                Worksheets(sh).Visible = xlSheetVisible
            Next sh
        Else
            'show users sheet(s)
            c = 4
            On Error Resume Next
            Do
                ws = CStr(wsUsers.Cells(Val(m), c).Text)
                If Len(ws) = 0 Then Exit Do
                Worksheets(ws).Visible = xlSheetVisible
                c = c + 1
            Loop
        End If
    Else
    
        MsgBox "You Do Not Have Authorised Access To This Workbook.", 16, "No Access"
        
    End If
Exit Sub

myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

If a sheet name is mis-spelt or the sheet is not present it will be skipped.

Note: I haven't coded the protection of the workbook structure
Barry    10 Mar 2016, 05:45
@Lucy

What is the value of the variable sSName at this point? when the code stops click debug, and type "?sSName<Enter>" into the Immediate window in VB Editor.

This needs to be a valid name of one of the worksheets in the Workbook, if not you'll get an error on this line and any subsequent line of code that uses the same reference. In the code above the protected sheets are hard coded as "u1sheet" and "u2sheet", if your worksheets aren't name the same or if you haven't modified the macro to reflect the actual sheet names then you will get an error.

Jurie    10 Mar 2016, 05:38
Hi Lucy,

Below is the code how I use it. This is the code for the control button.

Dim bOK2Use As Boolean
Private Sub btnOK_Click()
    Dim bError As Boolean
    Dim sSName As String
    Dim p As DocumentProperty
    Dim bSetIt As Boolean

    bOK2Use = False
    bError = True
    If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 Then
        bError = False
        Select Case txtUser.Text
            Case "user1"
                sSName = "Sheet1"
                If txtPass.Text <> "u1pass" Then bError = True
             Case "user2"
                sSName = "Sheet2"
                If txtPass.Text <> "u2pass" Then bError = True
            Case "manager"
                If txtPass.Text <> "manager" Then bError = True
            Application.EnableEvents = False
         End Select
    End If
    If bError Then
        MsgBox "Invalid User Name or Password"
    Else
        
                
        bOK2Use = True
        Unload UserForm1
End If
End Sub
Private Sub UserForm_Terminate()
    If Not bOK2Use Then
        ActiveWorkbook.Close (False)
    End If
End Sub

Leave the workbook module code intact. Try this and reply if still having problems..
lucy    09 Mar 2016, 10:27
Hi,

When i try to run this on Excel 2013 I get a run-time error 9: Subscript out of range.

The error occurs on the below command

Sheets(sSName).Visible = True

I read in one of the post that deleting this should resolve the issue but this isn't resolving it. Any ideas on how i fix this?

Many Thanks

Lucy
Niall    09 Mar 2016, 06:36
@Barry

"It is possible to just prompt for the user to enter their username and a password with a relatively minor code change."
What's the code change?

I'm very new to VBA and only stumbled across this article from a Google search

I have a workbook which will be accessed by multiple users, each user will need to see a different combination of sheets

The log in form would be ideal if I could get it to open more than one sheet

Thanks

Niall
Barry    04 Mar 2016, 12:14
@Jaco,

The code utilises another worksheet which has a list of permitted users, and against each user whether they have "admin" rights or not, and which sheets they are permitted to view. Only users with admin rights are allowed to view the worksheet with the list of users and access rights. This table has to be set-up initially on a worksheet named "Users".The list of users is in Column A, Admin privilege in Column B (TRUE = Admin, FALSE =not admin). Column C, D, E,....... has the sheet name that the user has permitted access to.

The code determines who the user is by using the line of code:
UsersName = Environ("USERNAME")
this code interrogates the operating system for the username of the person logged in on that computer.(It is possible to just prompt for the user to enter their username and a password with a relatively minor code change.).

So to answer your questions:

Q1. Each user has their own username which is the username they have when logging onto the computer. No additional password is required.

Q2. Yes. Only the worksheet permitted to be viewed by particular user are ever visible. Users not in the permitted user table in the users worksheet cannot see any worksheet. The "beforeclose" and "beforesave" routines hide all the worksheets prior to the saving or closing the workbook.

Q3. The list of users is in Column A, Admin privilege in Column B (TRUE = Admin, FALSE =not admin). Column C, D, E,....... has the sheet name that the user has permitted access to.

I hope this helps.

Barry
Jurie    04 Mar 2016, 05:39
Hi Jaco,

What do you need help with?
Jaco    03 Mar 2016, 13:41
Hi I'm new to VBA and have a similar project and looking for some assistance.

@Barry

Three questions:
1. Does this code allow for multiple users with each having a separate username and password to access different worksheets?
" Set wsUsers = Worksheets("Users")
    Set rng = wsUsers.Range(wsUsers.Range("A1"), wsUsers.Range("A" & wsUsers.Rows.Count).End(xlUp))"

2. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Workbook_BeforeClose False
End Sub

- Does this code allow for all sheets to be hidden, except for the active (chosen) sheet, the next time anyone opens up the workbook, even after it's been opened by the admin?

3. Where is the admin name and password set to allow him/her to access the entire workbook (all worksheet open up on signing in)?
Barry    01 Feb 2016, 09:09
@Jurie

The following code should do what you want. All the code should be located in the "ThisWorkBook" module:

Option Explicit
Dim shtCurrent As Worksheet

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    Workbook_Open
    shtCurrent.Activate
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim sh As Integer
    
    Set shtCurrent = ActiveSheet
    
    For sh = 1 To Worksheets.Count
        If Worksheets(sh).Name = "Home" Then
            Worksheets(sh).Visible = xlSheetVisible
        Else
            Worksheets(sh).Visible = xlSheetVeryHidden
        End If
    Next sh
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Workbook_BeforeClose False
End Sub

Private Sub Workbook_Open()
    Dim sh As Integer, c As Integer
    Dim rng As Range
    Dim UsersName As String, ws As String
    Dim m As Variant
    Dim wsUsers As Worksheet
    
    'hide all but sheet named "Home"
    For sh = 1 To Worksheets.Count
        If Worksheets(sh).Name = "Home" Then
            Worksheets(sh).Visible = xlSheetVisible
        Else
            Worksheets(sh).Visible = xlSheetVeryHidden
        End If
    Next sh
    
    Set wsUsers = Worksheets("Users")
    Set rng = wsUsers.Range(wsUsers.Range("A1"), wsUsers.Range("A" & wsUsers.Rows.Count).End(xlUp))
    
    UsersName = Environ("USERNAME")
    
    m = Application.Match(UsersName, rng, False)
    
    On Error GoTo myerror
    If Not IsError(m) Then
        If CBool(wsUsers.Cells(Val(m), 2).Value) Then
            'admin user
            For sh = 1 To Worksheets.Count
                Worksheets(sh).Visible = xlSheetVisible
            Next sh
        Else
            'show users sheet(s)
            c = 3
            Do
                ws = CStr(wsUsers.Cells(Val(m), c).Text)
                If Len(ws) = 0 Then Exit Do
                Worksheets(ws).Visible = xlSheetVisible
                c = c + 1
            Loop
        End If
    Else
    
        MsgBox "You Do Not Have Authorised Access To This Workbook.", 16, "No Access"
        
    End If
Exit Sub

myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Acknowledgement to "dmt32" on the mrexcel.com website for the core code.

Note: I haven't coded the protection of the workbook structure
Jurie    01 Feb 2016, 02:00
Hallo Barry,

I agree with what you said. I certainly wish my knowledge on VBA was better so I could help, especially these guys who have commented on this tip, in a much better way. Could you maybe help out on how to add extra sheets for a user?..using the existing code?
Barry    05 Jan 2016, 07:42
@Jurie,

I agree that the mrexel.com solution is the way to go, but it does have some holes in it as it stands that need plugging.

Firstly, the Workbook needs to be saved with its structure protected. Otherwise worksheets can be moved around, renamed, deleted, etc. This is particualrly relavent to the "Home" sheet which is the sheet on the far left of the Excel window, the code hides all other sheets other than this sheet. It would be better to hide all sheets other than the sheet with the CodeName "Sheet1".

Secondly, if the workbook is opened with macros disabled then the last saved copy with whosever sheets where visible will be shown. This will be crucial if the last user had "admin" rights when all worksheets would be visible, including the sheet with Users access rights. The sheets would better be hidden in the "BeforeSave" event (and then the Users sheets would have to be made visible again with the "AfterSave" event).
Jurie    05 Jan 2016, 01:21
Hi Max,

gosh I have been working on it really trying to get the code to add more sheets, but my experience with VBA seems to lack quite a bit. I have googled in the meantime and found this link: http://www.mrexcel.com/forum/excel-questions/910802-macor-help.html

I think this is the way to go. Sorry about that. Hope the link helps.
Jurie    04 Jan 2016, 09:17
Hi DAY,

This is the "manager" part. Case "manager"
                If txtPass.Text <> "manager" Then bError = True
            Application.EnableEvents = False

As soon as manager is logged on, events are disabled, so ALL sheets are viewable. In the "before close" event you must enable the events again, like this: Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableEvents = True
End Sub
kassim    02 Jan 2016, 05:28
Hi, I got everything done but each time I open the excel file, I see my last opened worksheet opened without the form displayed. Secondly, after I entered the utxt and upass, it takes me to vba editor even though the worksheet is opened on the other end.
max    26 Dec 2015, 16:42
Hey Jurie,

Hope you are well?

Can you please describe how to add more visible sheets to a user login?

I would be most grateful. I have tried numerous ways but no joy.
Mike    14 Dec 2015, 19:48
DAY,

I'm still stuck in the box.
How did you end up disabling and then enabling events?

Thanks
Jurie    11 Dec 2015, 05:27
You are more than welcome DAY, sorry if my explanations were not very clear, however, I'm glad you got it sorted!
DAY    10 Dec 2015, 15:59
Actually, I worked it out! To solve the remaining issue I had to think outside the box, which is one of my favorite pastimes! =P

Thanks again for all of your contributions to this project!
DAY    10 Dec 2015, 13:16
Jurie,

I've implemented all of this code to secure worksheets within a workbook and it works beautifully except for 1 piece that has been trouble.

If an admin is logged in, and "Disable Events" is on then where do you place the "Enable Events" so that the workbook is properly locked down again upon the admin closing?

If you place it in the "BeforeClose" event how is it triggered if "Disable Events" is on?

Please excuse me if I somehow am missing the obvious. I've been coding this for 2 days now and may be "lost in the code" when it comes to this issue.

Thank you for your help!
Jurie    01 Dec 2015, 06:09
Hi Kym,

Remove the "Sheets(sSName).Visible = True". You do not need it. This should ONLY be for the users. Just go through my previous post again...if anything is unclear, please give me a shout..
Kym    30 Nov 2015, 23:02
Hi, Jurie,

I have actually figured out the answer to my previous question. However, now when I run the macro under the user "manager", I receive a Runtime Error 9 at:

 Sheets(sSName).Visible = True

Any suggestions?


Kym    30 Nov 2015, 22:24
Jurie,

I am not a VBA Expert so I apologize in advance if my following question seems ridiculous. Can you please show the code that re-enables the events that you have written under the BEFORECLOSE EVENT?
Jurie    30 Nov 2015, 01:21
Hi OW,

Yes, I did the following.: Insert or modify for example "case 2" above:

Case "manager"
                If txtPass.Text <> "manager" Then bError = True
            Application.EnableEvents = False
 
I substituted user 2 with the above. Also, ignored the sSName part and also included to disable events.

This will allow "manager" or "admin" to be able to view all sheets.

REMEMBER..In your BEFORECLOSE EVENT, you MUST enable events again, otherwise user 1 will have all access!!..
OW    27 Nov 2015, 06:04
Hi did anyone find out how to create an admin login so all pages can be viewed with a single username? thanks
Jurie    27 Nov 2015, 04:12
Hi, I love this code!!. However I was wondering if this code could be tweaked to run with 2013 version?.
AVINASH    09 Oct 2015, 16:55
hi guys i understand that a code given below contains a protection instructions where the developer has restricted my excel file to 30 days trial i just want to edit that to unlimited period please help me on this.
AVINASH    09 Oct 2015, 16:53
Private Sub UserForm_Terminate()
Dim eDate As Date
protection.appname

eDate = protection.DeCrypt(GetSetting(appname:=App, Section:="Class", Key:="eD", Default:=protection.EnCrypt("01/01/80")))
If eDate < Now() Then
    Application.ScreenUpdating = False
    protection.lockall
End If
End Sub
Kathryn    08 Oct 2015, 19:35
Hi, I'm also wondering about how to add an admin account and open multiple sheets with the one username.
Ashley    19 Sep 2015, 21:09
Hi, Did any one find out how to add admin account on to this please

Thanks

Ashley
Ariel    11 Sep 2015, 13:01
Hello,

I am veru new at VB and Macros. When I click on the "play" button, I get the following error:

"Compile Error.
Expected End Sub".

Should I set any specific name to the Macro?. I have created the UseerForm1 with the 2 fields and the "ok" button with no issues. I think I am doing something wrong when creating the Macro thing.

Please assist.
Thank you.
Asha    11 Aug 2015, 16:20
Did anyone figure out how to add the admin user who can view all the worksheets? If yes, please help
Sebastian    04 Aug 2015, 09:08
Hi There, thanks a lot for this!

I have done everything as mentionned but get an error message right after opening file at this point:

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Any advise? Thanks a lot,
Joe    20 Jul 2015, 12:13
Is there a way to add and Admin login
Johnny    17 Jul 2015, 09:45
Hi all,
Please can someonw tell me how to add an Admin (who can view all sheets and create new sheets) and where to put that code, AND also how to disable VBA for non-Admin users?
Thank you!!!!
Owen Williams    14 Jul 2015, 11:36
Hi all I am really struggling, as am new to VBA. The textboxes are not appearing when I open the sheet, and when I run the UserForm in VBA to get the textboxes up, it throws me back into the designer part rather than the user's allocated sheet! Any help is REALLY appreciated!!!
LBinGA    17 Jun 2015, 09:28
Victoria,
You have two routines for BeforeClose. Consolidate your Subroutines and you should be fine.

LBinGA
LBinGA    17 Jun 2015, 09:25
To place the code OnActivate:
Go to ThisWorkbook in your VBAProject and place the following:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "Your Sheet Name" Then
        If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then
            Sh.Visible = False
            MsgBox "You don't have authorization to view that sheet!"
        End If
           End If
   End Sub

Hope that helps.
LBinGA    17 Jun 2015, 09:24
Sorry, I didn't see this til now. Go to ThisWorkbook in your VBAProject and place this code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "Your Sheet Name" Then
        If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then
            Sh.Visible = False
            MsgBox "You don't have authorization to view that sheet!"
        End If
           End If
   End Sub

Hope that helps.
Tammy    08 Jun 2015, 17:01
Hi! This is a really helpful tip. Would you be able to help me revise to do the following:
1. Add an Admin who could access all worksheets and disable VBA editor for all users except the Admin.
2. Allow specific users access to two sheets or possible more depending on the user.

Thanks!
Victoria    08 Jun 2015, 10:07
It gives me a Compile Error: Ambiguous name detected: Workbook_BeforeClose. Anyone know how to fix this?
Jenn    28 May 2015, 16:46
I am having the same problem as Jake. LB in GA, can you show me where you wrote in the code to open onactivate?
Barry    10 Apr 2015, 05:20
I would recommend when hiding the user worksheets that the sheet is made "very hidden" that way if macros are disabled when the workbook is opened the user cannot just unhide a worksheet to view/modify its contents.

The lines of code w.Visible=False should be change to w.Visible=xlVeryHidden
jake    09 Apr 2015, 18:48
Hey LBinGA,

I am having the same problem that you were. I get the runtime error 5 after entering the username and password and this line is highlighted.

If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then

I am a little confused about how to allow the UserForm to pop up OnActivate. Can you be a little more specific about how you fixed the problem?

Thanks,
Jake
LB in GA    29 Jan 2015, 10:21
Figured out why the one line of code was highlighted if anyone is interested. You must allow the UserForm to pop up OnActivate. I had not done that and moved it to a button instead. Therefore, when I tried to open one of the worksheets that is locked down, I was already authorized.
I did not want my client to have to log into the worksheet everytime, but I've made their User Login as a default so that it won't be so cumbersome. Works like a charm now.
LBinGA
LB in GA    28 Jan 2015, 16:14
Works great but for one thing. I get a Runtime Error 5 at this line:

If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then

when I try to unhide a password required Worksheet instead of the MsgBox opening. And, the unauthorized worksheet does actually open.

Is there any help for this?
Thanks
LB
maywenn    03 Dec 2014, 03:53
you are a life saver!! thanks!
Mangesh Tumne     09 Sep 2014, 03:40
After doing all trying to open with user name 'user1' and password 'u1sheet' but giving message invalid user name or password.please help.I want 6 such sh
eets?
Hisham Alaaedin    16 Aug 2014, 21:28
Allen,

your post is extremely helpful and it reassured me after i thought that something like this is nothing but a crazy thought in my head :)

i used your code and it works fine except for one thing, how can i add more sheets to a single user or is this a capability issue with excel VBA i tried this in many many ways but no luck so far

i really appreciate your help on this

thank you
john    23 May 2014, 14:06
I couldn't get past the line
Sheets(sSName).Visible = True.

Can someone help? Thanks
Rob    18 Apr 2014, 03:14
Hi, Thanks for this tip, really useful!
I wondered if you could help me enhance it in the following ways?
1. I'd like to add an 'Admin' user who can access all worksheets
2. I'd like only the admin to be able to save the workbook, save/save as should be disabled for all other users
3. VBA editor should be disabled in the workbook for all users except 'Admin'

Really appreciate your feedback
Paul Vaglio    16 Mar 2014, 17:36
Can this be modified to use a network user name?
josh    24 Feb 2014, 13:21
I am trying the above and I can not get it to work. I cant get the form to launch at open. Also once login i can easily unhide the other tabs. Why does this happen shouldnt they be locked?

So thankful for any help.
 
 

Our Company

Sharon Parq Associates, Inc.

About Tips.Net

Contact Us

 

Advertise with Us

Our Privacy Policy

Our Sites

Tips.Net

Beauty and Style

Cars

Cleaning

Cooking

DriveTips (Google Drive)

ExcelTips (Excel 97–2003)

ExcelTips (Excel 2007–2016)

Gardening

Health

Home Improvement

Money and Finances

Organizing

Pests and Bugs

Pets and Animals

WindowsTips (Microsoft Windows)

WordTips (Word 97–2003)

WordTips (Word 2007–2016)

Our Products

Helpful E-books

Newsletter Archives

 

Excel Products

Word Products

Our Authors

Author Index

Write for Tips.Net

Copyright © 2016 Sharon Parq Associates, Inc.