Restricting specific user sheets

[Linki]

Hi all,

I've been trying all sorts of random solutions I could find online (as I am unable to do VBA myself).

I'm making a sick leave & vacation sheet for my department and my fellow colleagues should only be able to see their own sheet (about 15 sheets, one for each in the team).
There will then be 1 master sheet used for filing paychecks, that compiles the information from all the other sheets - only myself should be able to see this one.

Searching this forum, I am looking for a similar solution as to what was discussed in THIS THREAD (i.e., identifying which person is logged in, and have only that persons respective sheet visible and all others very hidden).

We all use O365 with our work e-mails, hopefully that could be of use in the VBA code as user identifier? I liked the solution that was mentioned with having a "config" sheet, which has a column with usernames (account email?) and columns with which sheet they should be able to access - that would make it easy for someone like me to access and adjust in case of new hires etc.

I want to avoid passworded sheets/files, as it would make it complicated to compile information from multiple passworded locations into a master sheet - as far as I've understood it.

Hope anyone is able to hold my hand and guide my way through this, I appreciate any help I can get, thank you in advance!

 

[Candyman8019]

Okay...for using email, I've taken a different approach. Reopen the file using that same link I sent earlier. It's a simpler approach and should make things easier. You'll need to ensure you have the 'Microsoft Outlook xx.x Object Library' enabled in references. To do that, go into your VB editor | tools | references.

 

[Fluff]

@Candyman8019 please post the code to the site rather than just providing a link to a file, as per Rule#4

 

[Candyman8019]

As requested...

Private Sub workbook_open()
Dim email As String
Dim sht As Worksheet
Dim LastRow As Long

'hide all sheets...at least one sheet must remain visible.
'Use VeryHidden to ensure users cannot simply unhide other sheets without going into VBA.
For Each sht In Worksheets
    If sht.Name <> "Home" Then sht.Visible = xlSheetVeryHidden
Next

'determine email of current user
Dim objOutlook As New Outlook.Application
email = Trim(objOutlook.getnamespace("MAPI").currentuser.AddressEntry)

'Email = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Common\Identity\ADUserName")

LastRow = Sheet4.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

'Display sheet applicable to email
For x = 2 To LastRow
    If email = Sheet4.Range("A" & x).Value Then
        Worksheets(Sheet4.Range("B" & x).Value).Visible = True
    End If
Next x

End Sub

 

[Linki]

As requested...

Private Sub workbook_open()
Dim email As String
Dim sht As Worksheet
Dim LastRow As Long

'hide all sheets...at least one sheet must remain visible.
'Use VeryHidden to ensure users cannot simply unhide other sheets without going into VBA.
For Each sht In Worksheets
    If sht.Name <> "Home" Then sht.Visible = xlSheetVeryHidden
Next

'determine email of current user
Dim objOutlook As New Outlook.Application
email = Trim(objOutlook.getnamespace("MAPI").currentuser.AddressEntry)

'Email = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Common\Identity\ADUserName")

LastRow = Sheet4.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

'Display sheet applicable to email
For x = 2 To LastRow
    If email = Sheet4.Range("A" & x).Value Then
        Worksheets(Sheet4.Range("B" & x).Value).Visible = True
    End If
Next x

End Sub

So the good news is, it loads really smooth. No freezing or anything.
The bad news is, it only shows me the Home tab, after inserting my own e-mail address associated with Sheet6, I still just get the Home tab when I re-open the file.
The password to show all sheets still works like a charm!
Also ensured that the Outlook Object was enabled in references as you mentioned
I so badly want to be able to come with a smart suggestion, but I am way out of my depth here :D

 

[Candyman8019]

On the config tab, make sure the name of the sheets listed next to your email address are identical to the applicable tab name.

 

[Linki]

On the config tab, make sure the name of the sheets listed next to your email address are identical to the applicable tab name.

It adds up : / I'm just using your file for now, have not changed anything other than replacing one email with my own.

 

[Candyman8019]

Okay, let's see what email address it is coming up with for you. Try this code...the only change is that your email will display in a message box

Private Sub workbook_open()
Dim email As String
Dim sht As Worksheet
Dim LastRow As Long



'hide all sheets...at least one sheet must remain visible.
'Use VeryHidden to ensure users cannot simply unhide other sheets without going into VBA.
For Each sht In Worksheets
    If sht.Name <> "Home" Then sht.Visible = xlSheetVeryHidden
Next

'determine email of current user
Dim objOutlook As New Outlook.Application
email = Trim(objOutlook.getnamespace("MAPI").currentuser.AddressEntry)

'DISPLAY EMAIL ADDRESS
MsgBox email

'Email = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Common\Identity\ADUserName")
'allows opening of app on non-domain connected computer.
On Error Resume Next


LastRow = Sheet4.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Display sheet applicable to department
For x = 2 To LastRow
    If email = Sheet4.Range("A" & x).Value Then
        Worksheets(Sheet4.Range("B" & x).Value).Visible = True
    End If
Next x

End Sub

 

[Linki]

Okay, let's see what email address it is coming up with for you. Try this code...the only change is that your email will display in a message box

Private Sub workbook_open()
Dim email As String
Dim sht As Worksheet
Dim LastRow As Long



'hide all sheets...at least one sheet must remain visible.
'Use VeryHidden to ensure users cannot simply unhide other sheets without going into VBA.
For Each sht In Worksheets
    If sht.Name <> "Home" Then sht.Visible = xlSheetVeryHidden
Next

'determine email of current user
Dim objOutlook As New Outlook.Application
email = Trim(objOutlook.getnamespace("MAPI").currentuser.AddressEntry)

'DISPLAY EMAIL ADDRESS
MsgBox email

'Email = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Common\Identity\ADUserName")
'allows opening of app on non-domain connected computer.
On Error Resume Next


LastRow = Sheet4.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Display sheet applicable to department
For x = 2 To LastRow
    If email = Sheet4.Range("A" & x).Value Then
        Worksheets(Sheet4.Range("B" & x).Value).Visible = True
    End If
Next x

End Sub

Ah it was not able to get my email, it returned my username.
I went back to the previous code you sent just before this one, and entered my username instead of e-mail and it worked!
E-mail would have been great but this will definitely be very satisfactory!

I'll try insert it into my stuff and well it should work great! So exciting! Thank you Candyman!

 

[Candyman8019]

Ah it was not able to get my email, it returned my username.
I went back to the previous code you sent just before this one, and entered my username instead of e-mail and it worked!
E-mail would have been great but this will definitely be very satisfactory!

I'll try insert it into my stuff and well it should work great! So exciting! Thank you Candyman!

You're very welcome. Happy to help...

 

[Linki]

You're very welcome. Happy to help...

Hi Candyman
I've been working on incorporating my stuff into the file you sent.
Now I'm getting this error when I open the file - it still seems to work, so I don't know what this error message is about:

Debug refers to:

Do you know why that might be?