Protecting pages from viewing using network username

BlissC

New Member
Joined
Aug 28, 2017
Messages
47
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi everyone,

I'm using this VBA script from the 3rd post on this thread: Password Protect Viewing for Multiple Worksheets (code below) to control access to different pages in my workbook, which uses the network username to control who gets to see what, and the script itself is working fine. There's just one problem though - every time it runs (i.e. each time the workbook's opened), it removes the sheet protection on each sheet (i.e. via 'Protect Sheet') which prevents any of the formulas from being accidentally overwritten. With the same password on all pages, it just unlocks them all!

I've also tried just putting the password that you specify in the code at the start of the code in the standard module just on the HomeSheet page and the Userlist table tab it creates, and giving all the other sheets a different password, but when I do that, all it opens is the HomeSheet tab.

I'm really pleased it works to control access to the pages, but with the protection removed from the sheets, knowing that some of my users suffer from "fat fingers" and accidentally hit keys they don't mean to on a regular basis, I fear that I'm going to be having to constantly go into the workbook to fix cells where someone's overwritten a formula.

Does anyone know how I can either get it to stop removing the sheet protection, or get it to re-apply the protection once it's opened please?

Thanks,

Bliss

Standard module:

VBA Code:
 'add password as required
Public Const shPassword As String = ""
   'change Main sheet name as required
Public Const HomeSheet As String = "Home"

Function IsValidUser(ByRef Target As Range, ByRef Admin As Boolean) As Boolean
'function looks for valid username in user list worksheet
    Dim FindCell As Range


    Set FindCell = Target.Find(Environ("USERNAME"), LookIn:=xlValues, lookat:=xlWhole)
    If Not FindCell Is Nothing Then
        Admin = FindCell.Offset(0, 1)
        Set Target = FindCell
        IsValidUser = True
    End If


End Function


Sub BuildTable(ByVal ws As Object)
'builds table of all worksheets available in workbook
'table is updated if new sheets are added when activated
'by an admin user.
    Dim sh As Worksheet
    Dim LastCol As Long
    Dim m As Variant


        With ws
            .Unprotect Password:=shPassword
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        End With


        'add sheet names to row 1
        For Each sh In Worksheets
            Select Case sh.Name
            Case HomeSheet, "User List"


            Case Else
            On Error Resume Next
            m = Application.Match(sh.Name, ws.Cells(1, 1).Resize(1, LastCol), False)
            If IsError(m) Then ws.Cells(1, LastCol).Value = sh.Name: LastCol = LastCol + 1
            End Select
    Next
End Sub


Function UserTable(ByVal SheetName As String) As Worksheet
'Function sets object reference to User List worksheet
'if it does not exist it is added
    On Error Resume Next
        Set UserTable = ThisWorkbook.Worksheets(SheetName)
        If UserTable Is Nothing Then
        Application.ScreenUpdating = False
        Set UserTable = Worksheets.Add(after:=Worksheets(1))
        With UserTable
            .Name = "User List"
            .Range("A1:B1").Value = Array("User Name", "Admin")
            .Columns(1).ColumnWidth = 15
            .Columns(2).ColumnWidth = 8
            .Range("A2").Value = Environ("USERNAME")
            .Range("B2").Value = True
          End With
          'build table
          BuildTable ws:=UserTable
        End If
    On Error GoTo 0
End Function

Sub HideSheets()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
            If sh.Name = HomeSheet Then
                'do nothing
            Else
                sh.Visible = xlSheetVeryHidden
               If Len(shPassword) > 0 Then sh.Protect Password:=shPassword
            End If
    Next sh
End Sub

ThisWorkbook:

VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)   
  HideSheets
End Sub


Private Sub Workbook_Open()
    Dim Admin As Boolean
    Dim msg As Variant
    Dim LastCol As Integer, c As Integer
    Dim rng As Range
    Dim sh As Worksheet, UserList As Worksheet
    


    On Error GoTo myerror
    
        ThisWorkbook.Sheets(HomeSheet).Visible = xlSheetVisible
      
        HideSheets


        Set UserList = UserTable("User List")
      
        With UserList
            .Unprotect Password:=shPassword
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            Set rng = .Range("A2:A" & lastrow)
        End With


    'check valid user
    If IsValidUser(rng, Admin) Then
            Application.ScreenUpdating = False
            'Admin User unhide all sheets
            If Admin Then
                For Each sh In ThisWorkbook.Worksheets
                    sh.Visible = xlSheetVisible
                    sh.Unprotect Password:=shPassword
                Next sh
            Else
                'unhide user sheets
                With UserList
                    For c = 3 To LastCol
                        If UCase(.Cells(rng.Row, c).Value) = "X" Then
                            With Sheets(.Cells(1, c).Value)
                                .Visible = xlSheetVisible
                                .Unprotect Password:=shPassword
                            End With
                        End If
                    Next c
                   If Len(shPassword) > 0 Then .Protect Password:=shPassword
                End With
            End If
            'activate home sheet
            Worksheets(HomeSheet).Activate
            
        Else
            'user not valid
            If Len(shPassword) > 0 Then UserList.Protect Password:=shPassword
            MsgBox "You Do Not Have Access To This File", 16, "Access Invalid"
            ThisWorkbook.Close False
        End If
        
myerror:
Application.ScreenUpdating = True
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"


End Sub




Private Sub Workbook_SheetActivate(ByVal sh As Object)
    If sh.Name = "User List" Then BuildTable ws:=sh
End Sub
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Hi,
In the workbook open event - try either commenting out the line shown in BOLD & see this does what you want
Or change it to .Protect Password:=shPassword
To make sure that sheet(s) are protected

Rich (BB code):
'unhide user sheets
                With UserList
                    For c = 3 To LastCol
                        If UCase(.Cells(rng.Row, c).Value) = "X" Then
                            With Sheets(.Cells(1, c).Value)
                                .Visible = xlSheetVisible
                                .Unprotect Password:=shPassword
                            End With
                        End If
                    Next c

Dave
 
Upvote 0
Solution
Hi Dave,

Thanks for your reply. I've tried both the commenting out that line, and changing it to .Protect Password:=shPassword, but with both it was still taking the protection off all the sheets.

On a hunch though I tried in the section just above that changing sh.Unprotect Password:=shPassword to sh.Protect Password:=shPassword. That seems to be working okay for me - it's leaving the sheets protected, but I'm wondering if because of where it is in the code, is it just doing that for admin users, or will it work for all users? (I haven't been able to test it with any of my users yet because they all seem to have logged out early for the day today!)

Rich (BB code):
  'check valid user
    If IsValidUser(rng, Admin) Then
            Application.ScreenUpdating = False
            'Admin User unhide all sheets
            If Admin Then
                For Each sh In ThisWorkbook.Worksheets
                    sh.Visible = xlSheetVisible
                    sh.Protect Password:=shPassword
                Next sh
            Else
                'unhide user sheets
                With UserList
                    For c = 3 To LastCol
                        If UCase(.Cells(rng.Row, c).Value) = "X" Then
                            With Sheets(.Cells(1, c).Value)
                                .Visible = xlSheetVisible
                                '.Protect Password:=shPassword
                            End With
                        End If
                    Next c

Thanks,

Bliss
 
Last edited:
Upvote 0
Hi,
Code was originally written by me over 5 years ago for another on this site & probably could do with some updating - Code unhides & unprotects sheets for specified users in list but protection state is hard coded - you should be able to change this in the unhide user sheets section of code by replacing UnProtect line with Protect. Admin users were given full access (no protection) but again, you should be able to change this if needed.

At some stage, may re-visit the code & see if can update it to allow Admin to specify Protection status for each user.

Dave
 
Upvote 0
Aahhh! That makes sense now! (and explains why I couldn't see any difference in the protection state as an Admin user)

Thanks again for your help!

Bliss
 
Upvote 0
Aahhh! That makes sense now! (and explains why I couldn't see any difference in the protection state as an Admin user)

Thanks again for your help!

Bliss

welcome - glad find code helpful

Dave
 
Upvote 0
Hello dmt32 if you happen to see this post. I am after something similar to the OP's request and tried out your code and followed the instructions as outlined in the original post where you posted the code. However, when I open the spreadsheet, all I keep getting is a pop-up error box with the message "The password you supplied is not correct. Verify that the CAPS LOCK key is off and be sure to use the correct capitalization". There is no option for me to set/create/enter any password before or when the spreadsheet is opened. Also, when the sheet opens (after I click 'OK' on the error box and it disappears) I am able to see the 'Home' tab, and another tab I named 'data, which I see irrespective of me putting 'X' in the column for 'data' against my username. However, all other tabs I put 'X' against , I do not see. and by the way I have 'TRUE' under the 'Admin' tab against my name. Any idea what the issue is please or able to assist? Thank you
 
Upvote 0
Hi,
at the very TOP of standard module you should have these variables

Rich (BB code):
'add password as required
Public Const shPassword As String = ""
   'change Main sheet name as required
Public Const HomeSheet As String = "Home"

You enter the sheet password between the quote marks - (must be same password for all sheets)

Dave
 
Upvote 0
Hi dmt32, wow! thanks for the prompt response, I am most grateful! I have put a password between the " " in the Public Const shPassword As String = "". However, VBA was highlighting an issue (i.e. yellow highlight when debugged) at the line sh.Visible = xlSheetVeryHidden under the HideSheets( ) function in the module. I thought may be I had to manually protect every single sheet in the workbook first before applying code and opening the workbook, so I manually protected all 24 sheets in the workbook, but I am still getting the same issue/error
 
Upvote 0
One sheet must remain visible - did you include a sheet called Home as specified in the public variable?

Public Const HomeSheet As String = "Home"
 
Upvote 0

Forum statistics

Threads
1,213,533
Messages
6,114,179
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top