VBA to hide worksheets based on windows user names..

[MarkRush]

I have been working on a new quoting tool for my organization and I guess I did such a great job( in large part to this forum! Thank you to everyone!) that the Engineers are worried that the sales people will create quotes without engineering overview and create some serious issues..

I have been tasked to lock portions of the quote tool based on if a Sales Engineer or other person opens the workbook. I can do this easily with a password prompt but passwords are prone to leaks, forgetting, etc etc..

I would really like to do this by using the Environ statement I found the following that looks like it will work, but would require me to duplciate the macro based on every username allowed to have full access.

WinUser = Environ("USERNAME") ' Windows username

Private Sub Auto_Open()
' This macro unhides sheets when the user set below opens the workbook
' It is a Private Sub to prevent it being listed with other macros

On Error Resume Next

If Application.UserName = "[I]Enter Username Here[/I]" Then
     Worksheets("Sheet2").Visible = True ' First sheet to be made visible
     Worksheets("Sheet3").Visible = True ' More can be listed here
End If

End Sub

Private Sub Auto_Close()
' This macro ensures the sheets are hidden when any user closes the workbook

On Error Resume Next

Worksheets("Sheet2").Visible = xlSheetVeryHidden ' Hide worksheets
Worksheets("Sheet3").Visible = xlSheetVeryHidden ' Other sheets to be hidden

End Sub

What I would like to do is have a worksheet with a list of all Engineer usernames and search that list to see who gets unfettered access. And then once the workbook is complete , Set a flag that changes what Sales people can see.

As an example. Sales opens workbook their username isn't defined and they can only see sheets 1-5, Engineer opens workbook, Their username is defined and they can see sheets 1-10. Engineer processes all the forms, Completes quote then presses a macro button called return to sales .. Sales opens completed workbook and can now see sheets 1-5, 9 and 10.. Sheets 7,8 and 9 are VeryHidden.

Any help would be much appreciated..

 

[dmt32]

Hi,
have a look here:https://www.mrexcel.com/forum/excel...word-protect-viewing-multiple-worksheets.html

#post3 & see if solution goes in direction you want.

Dave

 

[MarkRush]

its very close dave.. I replied on the other thread..

 

[dmt32]

its very close dave.. I replied on the other thread..

Hi,
that thread is closed - should keep all your posts to this current thread.

"What I would like to do is have a worksheet with a list of all Engineer usernames and search that list to see who gets unfettered access. And then once the workbook is complete , Set a flag that changes what Sales people can see.

Solution should do largely what you want. When workbook is first opened, a table is created (User List) Listing

Column A - UserName

Column B - Admin

Column C onward - all sheet names. Any sheets added at later stage table will automatically update.

your network username will be added by default as an Admin user.

In column A you add all other users network usernames & if not admin users who need to see all sheets, set column B False (or leave blank)
you then place an X under the sheet name headings as required for each user.

You can modify the solution t meet specific project need as required.

Dave

 

[MarkRush]

With your solution I have to update with the employee name for every sales person.. over 1000 sales people and they come and go quickly.. Engineers are much more stable and since they are part of my organization I can get the usernames quickly.. So based on the above.. Can I add a wildcard user entry at end of the table, that states if no match open pages 1-5, if match open pages 1-10.. And the ability for after the engineers have finished to set an entry that allows sales to open1-5,9 and 10?

for the wildcard entry all of our usernames are alphanumeric and start with n and followed by 7 numbers.. As an example n0123456

 

[dmt32]

Hi,
your requirement seems more complex than the solution was designed for.

you can partly accommodate the requirement to open certain pages when no UserName match is found by changing following:


In the WorkBook_Open code change this part:

       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

for this:

        Else
'user not valid
    
            For c = 3 To LastCol
                If UCase(UserList.Cells(2, c).Value) = "X" Then
                    With Sheets(UserList.Cells(1, c).Value)
                        .Visible = xlSheetVisible
                        .Unprotect Password:=shPassword
                    End With
                End If
            Next c
'activate home sheet
            Worksheets(HomeSheet).Activate
            If Len(shPassword) > 0 Then UserList.Protect Password:=shPassword
        End If

Then in the User List table

Move your name & admin values to Row 3

In row 2 enter "None" for UserName and False for Admin
Then place a X under each sheet name you want to be visible where no username is matched.

Dave

 

[MarkRush]

Dave, played with this on Friday and got to work except that I get a msgbox stating the password you supplied is not correct, Verify that the CAPS LOCK key is off and be sure to use the correct capitlization. I did change home sheet to Main tab.. But other than that it gives me the bad password prompt as soon as I open the workbook. I tried with your original code and the revised code.. I thought it may be because I have the VBA project itself password protected but I removed that and still got the bad password

Also once I add the NONE option it only opens the sheets specified for none, except i do get the user list sheet .

code for Module :

 'add password as requiredPublic Const shPassword As String = ""
   'change Main sheet name as required
Public Const HomeSheet As String = "Main"


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

Code for workbook

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

 

[MarkRush]

ok found the problem with the bad password.. Problem was i had sheets that were already protected with a seperate password.. How do I update your macro to use my password. .. I have to keep certain sheets protected..

 

[dmt32]

ok found the problem with the bad password.. Problem was i had sheets that were already protected with a seperate password.. How do I update your macro to use my password. .. I have to keep certain sheets protected..

Hi,
At the top of the standard module you should have this line

'add password as required
Public Const shPassword As String = "YOURPASSWORDHERE"

enter your password where shown in red.

Dave

 

[MarkRush]

Dave, wanted to say thank you very much for your help.. Everything is working well, but noticed one more issue.. Every time the workbook opens it creates a new tab called D%$&01_DevSheet that is just filled with garbage

is it safe to just append the macro to delete that worksheet ?

I have uploaded an url to a picture
http://prntscr.com/iy8skd