Username Access to Different Sheets

R

rachelkirk

New Member
Joined
Jan 16, 2013
Messages
18
I have been reading the post of "Rights Management" and I could not figure out why my code doesn't work.

For the 15 worksheets in the workbook, the management can read all while others can access only a number of them. There is a password to open the file. However, since the management do not want any password, I would like to use environ(username) to do this. I pasted the following code in the Workbook (Code), switch the should-be-"Very hidden" sheets to "Very hidden" but nothing happens. Please kindly help.

Option Explicit
Option Compare Text

Sub openup()

Dim vauth As Variant
Dim i As Integer

'Assume Not Authorsied
Sheets("1").Visible = True
Sheets("2").Visible = True
Sheets("3").Visible = True
Sheets("4").Visible = True
Sheets("6").Visible = True
Sheets("7").Visible = True
Sheets("8").Visible = True
Sheets("9").Visible = True
Sheets("10").Visible = xlVeryHidden
Sheets("11").Visible = True
Sheets("12").Visible = xlVeryHidden
Sheets("13").Visible = xlVeryHidden
Sheets("14").Visible = xlVeryHidden
Sheets("15").Visible = xlVeryHidden
Sheets("16").Visible = xlVeryHidden
Sheets("17").Visible = xlVeryHidden
Sheets("18").Visible = xlVeryHidden
Sheets("19").Visible = xlVeryHidden
Sheets("20").Visible = xlVeryHidden
Sheets("21").Visible = True
Sheets("22").Visible = xlVeryHidden
Sheets("23").Visible = True

who = LCase(Environ("username"))

vauth = Array("rachel", "patrick", "linda", "etc")

For i = LBound(vauth) To UBound(vauth)
If LCase(Environ("username")) = vauth(i) Then
'Deffo Authorised
Sheets("1").Visible = True
Sheets("2").Visible = True
Sheets("3").Visible = True
Sheets("4").Visible = True
Sheets("6").Visible = True
Sheets("7").Visible = True
Sheets("8").Visible = True
Sheets("9").Visible = True
Sheets("10").Visible = xlVeryHidden
Sheets("11").Visible = True
Sheets("12").Visible = True
Sheets("13").Visible = True
Sheets("14").Visible = True
Sheets("15").Visible = xlVeryHidden
Sheets("16").Visible = True
Sheets("17").Visible = True
Sheets("18").Visible = True
Sheets("19").Visible = True
Sheets("20").Visible = True
Sheets("21").Visible = True
Sheets("22").Visible = True
Sheets("23").Visible = True
Exit Sub ' if you don't intend to do anything else in this sub
End If
Next i

End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
rachelkirk said:
I have been reading the post of "Rights Management" and I could not figure out why my code doesn't work.

For the 15 worksheets in the workbook, the management can read all while others can access only a number of them. There is a password to open the file. However, since the management do not want any password, I would like to use environ(username) to do this. I pasted the following code in the Workbook (Code), switch the should-be-"Very hidden" sheets to "Very hidden" but nothing happens. Please kindly help.

Option Explicit
Option Compare Text

Sub openup()

Dim vauth As Variant
Dim i As Integer

'Assume Not Authorsied
Sheets("1").Visible = True
Sheets("2").Visible = True
Sheets("3").Visible = True
Sheets("4").Visible = True
Sheets("6").Visible = True
Sheets("7").Visible = True
Sheets("8").Visible = True
Sheets("9").Visible = True
Sheets("10").Visible = xlVeryHidden
Sheets("11").Visible = True
Sheets("12").Visible = xlVeryHidden
Sheets("13").Visible = xlVeryHidden
Sheets("14").Visible = xlVeryHidden
Sheets("15").Visible = xlVeryHidden
Sheets("16").Visible = xlVeryHidden
Sheets("17").Visible = xlVeryHidden
Sheets("18").Visible = xlVeryHidden
Sheets("19").Visible = xlVeryHidden
Sheets("20").Visible = xlVeryHidden
Sheets("21").Visible = True
Sheets("22").Visible = xlVeryHidden
Sheets("23").Visible = True

who = LCase(Environ("username"))

vauth = Array("rachel", "patrick", "linda", "etc")

For i = LBound(vauth) To UBound(vauth)
If LCase(Environ("username")) = vauth(i) Then
'Deffo Authorised
Sheets("1").Visible = True
Sheets("2").Visible = True
Sheets("3").Visible = True
Sheets("4").Visible = True
Sheets("6").Visible = True
Sheets("7").Visible = True
Sheets("8").Visible = True
Sheets("9").Visible = True
Sheets("10").Visible = xlVeryHidden
Sheets("11").Visible = True
Sheets("12").Visible = True
Sheets("13").Visible = True
Sheets("14").Visible = True
Sheets("15").Visible = xlVeryHidden
Sheets("16").Visible = True
Sheets("17").Visible = True
Sheets("18").Visible = True
Sheets("19").Visible = True
Sheets("20").Visible = True
Sheets("21").Visible = True
Sheets("22").Visible = True
Sheets("23").Visible = True
Exit Sub ' if you don't intend to do anything else in this sub
End If
Next i

End Sub
Click to expand...

Welcome to Mr Excel!

A couple things that could throw a monkey wrench into this:
1) The user must have macros enabled for this code to run.
2) The name of the macro isn't what Excel runs for a workbook open event. Change it to "Private Sub Workbook_Open()"
 
Upvote 0
Thanks, MrKowz.

However, my boss expanded my 12 worksheets to 20 and required different worksheets to be viewable by different users. I'm a novice in vba and am searching for any threads regarding creating a worksheet to store the usernames and their authorized worksheets. Any ideas?
 
Upvote 0
You can do what you want so long as you appreciate that nothing in excel is secure & anything you do in VBA only works if user enables macros.
try following & see if does what you want:
1 – Add ALL code below to the THISWORKBOOK code page of your workbook.
2 – Save & Close workbook
3 – Re-Open workbook & you should be taken to a newly added sheet named "User List"
4 – By Default, your username has been added to Col A & Col B Shows TRUE.
This gives you admin access to all the sheets in workbook book.
5 – To Add additional users:
Col A, - enter users network USERNAME.
Col B - Set FALSE (true if others are required to maintain access list)
Col C onward -
you will have a data validation list of every sheet name in your workbook
- select a sheet & you will be moved to next Col. The Validation list is updated to exclude previously selected sheet's.

When done - save workbook.
You will note that another worksheet has been added called HOME - this is required as one worksheet must always remain visible. You can add what you like to this sheet perhaps a message to your users or name of your workbook.

I've not fully tested code but hopefully should do what you want.

Dave.

Code: 
Dim wsHome As Worksheet
Dim wsUser As Worksheet
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'hide all but home sheet
    Application.DisplayAlerts = False
    If wsHome Is Nothing Then Set wsHome = Worxsheet("Home")
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name > wsHome.Name Then Sh.Visible = xlSheetVeryHidden
    Next Sh
    Application.DisplayAlerts = True
End Sub

Private Sub Workbook_Open()
    Dim ValidUser As Variant, SheetName As Variant
    Dim NewSh As Boolean, Admin As Boolean
    Dim Sh As Worksheet
    Dim i, rng As Range
    Dim lastcol As Integer
    Set wsHome = Worxsheet("Home")
    Set wsUser = Worxsheet("User List", NewSh)
    If NewSh Then
        With wsUser
            .Range("A1").Value = Environ("Username")
            .Range("B1").Value = True
            .Activate
        End With
    Else
        With wsHome
            .Visible = xlSheetVisible
            .Activate
        End With
    End If
    Application.ScreenUpdating = False
    For Each Sh In ThisWorkbook.Worksheets
        'hide all but home sheet
        If Sh.Name <> wsHome.Name Then Sh.Visible = xlSheetVeryHidden
    Next Sh
    'names of valid users
    With wsUser
        Set rng = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With
    On Error Resume Next
    ValidUser = Application.Match(Environ("Username"), rng, False)
    If Not IsError(ValidUser) Then
        With wsUser
            Admin = .Cells(ValidUser, 1).Offset(0, 1).Value
            If Admin Then
                For Each Sh In ThisWorkbook.Worksheets
                    Sh.Visible = xlSheetVisible
                Next Sh
            Else
                i = 0
                lastcol = .Cells(ValidUser, .Columns.Count).End(xlToLeft).Column
                'make array of allowed sheets names
                SheetName = .Range(.Cells(ValidUser, 3), .Cells(ValidUser, lastcol)).Value
                'make visible all sheets in array
                For i = LBound(SheetName, 2) To UBound(SheetName, 2)
                    Worksheets(SheetName(1, i)).Visible = xlSheetVisible
                Next i
            End If
        End With
        Application.ScreenUpdating = True
    Else
        Application.ScreenUpdating = True
        msg = MsgBox("You Do Not Have Access To This File", 16, "Warning")
        ThisWorkbook.Close False
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If wsUser Is Nothing Then Set wsUser = Worxsheet("User List")
    If Sh.Name = wsUser.Name Then Target.Offset(0, 1).Select
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim txt As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim SheetName As Variant
    If wsUser Is Nothing Then Set wsUser = Worxsheet("User List")
    If Sh.Name = wsUser.Name Then
        Application.EnableEvents = False
        lastrow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
        If Target.Row > lastrow Then
            lastrow = lastrow + 1
            Sh.Cells(lastrow, Target.Column).Select
        Else
            lastrow = Target.Row
        End If
        Select Case Target.Column
        Case 1
            GoTo endprog
        Case 2
            With Target.Validation
                .Delete
                .Add _
                        Type:=xlValidateList, _
                        AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:="True,False"
            End With
        Case Else
            If Sh.Cells(Target.Row, 2).Value = True Then GoTo endprog
            'build list of worksheets assigned to employee
            'find last entry col
            lastcol = Sh.Cells(lastrow, Sh.Columns.Count).End(xlToLeft).Column
            If lastcol < 2 Then lastcol = 2
            'move seleced cell to next available col
            If Target.Column > lastcol Then Sh.Cells(lastrow, lastcol + 1).Select
            'set range of available worksheets
            Set rng = Sh.Range(Sh.Cells(lastrow, 3), Sh.Cells(lastrow, lastcol))
            'build validation list of worksheet names
            '
            On Error Resume Next
            For Each ws In ThisWorkbook.Worksheets
                Select Case ws.Name
                Case Sh.Name, "Home"
                Case Else
                    SheetName = Application.Match(ws.Name, rng, False)
                    If IsError(SheetName) Then txt = txt & ws.Name & ","
                End Select
            Next
            txt = Left(txt, Len(txt) - 1)
            With Target.Validation
                .Delete
                .Add _
                        Type:=xlValidateList, _
                        AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:=txt
            End With
        End Select
    End If
endprog:
    Application.EnableEvents = True
End Sub

Function Worxsheet(ByVal Sh As String, Optional ByRef NewSheet As Boolean = False) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next
    With ThisWorkbook
        Set ws = .Worksheets(Sh)
        If Err.Number = 9 Then
            Set ws = .Worksheets.Add
            ws.Move after:=.Worksheets(Sheets.Count)
            ws.Name = Sh
            NewSheet = True
        End If
    End With
    
    Set Worxsheet = ws
End Function
 
Upvote 0
Dave, thank you very much. The "Home" and the administrator function works beautifully. The dropdown menu works too.

However, I don't know why the worksheets are kind of messed up. The sheets that I put as visible but do not select appear. Those I put as very hidden but selected do not appear. Those I select and put as visible also do not appear.

I only modified the code a little bit by adding the date and username stamp. Would you be able to help?

Dim wsHome As Worksheet
Dim wsUser As Worksheet
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'hide all but home sheet
Application.DisplayAlerts = False
If wsHome Is Nothing Then Set wsHome = Worxsheet("Home")
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name > wsHome.Name Then Sh.Visible = xlSheetVeryHidden
Next Sh
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_Open()
Dim ValidUser As Variant, SheetName As Variant
Dim NewSh As Boolean, Admin As Boolean
Dim Sh As Worksheet
Dim i, rng As Range
Dim lastcol As Integer
Set wsHome = Worxsheet("Home")
Set wsUser = Worxsheet("User List", NewSh)
If NewSh Then
With wsUser
.Range("A1").Value = Environ("Username")
.Range("B1").Value = True
.Activate
End With
Else
With wsHome
.Visible = xlSheetVisible
.Activate
End With
End If
Application.ScreenUpdating = False
For Each Sh In ThisWorkbook.Worksheets
'hide all but home sheet
If Sh.Name <> wsHome.Name Then Sh.Visible = xlSheetVeryHidden
Next Sh
'names of valid users
With wsUser
Set rng = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With
On Error Resume Next
ValidUser = Application.Match(Environ("Username"), rng, False)
If Not IsError(ValidUser) Then
With wsUser
Admin = .Cells(ValidUser, 1).Offset(0, 1).Value
If Admin Then
For Each Sh In ThisWorkbook.Worksheets
Sh.Visible = xlSheetVisible
Next Sh
Else
i = 0
lastcol = .Cells(ValidUser, .Columns.Count).End(xlToLeft).Column
'make array of allowed sheets names
SheetName = .Range(.Cells(ValidUser, 3), .Cells(ValidUser, lastcol)).Value
'make visible all sheets in array
For i = LBound(SheetName, 2) To UBound(SheetName, 2)
Worksheets(SheetName(1, i)).Visible = xlSheetVisible
Next i
End If
End With
Application.ScreenUpdating = True
Else
Application.ScreenUpdating = True
Msg = MsgBox("You Do Not Have Access To This File", 16, "Warning")
ThisWorkbook.Close False
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If wsUser Is Nothing Then Set wsUser = Worxsheet("User List")
If Sh.Name = wsUser.Name Then Target.Offset(0, 1).Select
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim txt As String
Dim ws As Worksheet
Dim rng As Range
Dim SheetName As Variant
If wsUser Is Nothing Then Set wsUser = Worxsheet("User List")
If Sh.Name = wsUser.Name Then
Application.EnableEvents = False
lastrow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
If Target.Row > lastrow Then
lastrow = lastrow + 1
Sh.Cells(lastrow, Target.Column).Select
Else
lastrow = Target.Row
End If
Select Case Target.Column
Case 1
GoTo endprog
Case 2
With Target.Validation
.Delete
.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="True,False"
End With
Case Else
If Sh.Cells(Target.Row, 2).Value = True Then GoTo endprog
'build list of worksheets assigned to employee
'find last entry col
lastcol = Sh.Cells(lastrow, Sh.Columns.Count).End(xlToLeft).Column
If lastcol < 2 Then lastcol = 2
'move seleced cell to next available col
If Target.Column > lastcol Then Sh.Cells(lastrow, lastcol + 1).Select
'set range of available worksheets
Set rng = Sh.Range(Sh.Cells(lastrow, 3), Sh.Cells(lastrow, lastcol))
'build validation list of worksheet names
'
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case Sh.Name, "Home"
Case Else
SheetName = Application.Match(ws.Name, rng, False)
If IsError(SheetName) Then txt = txt & ws.Name & ","
End Select
Next
txt = Left(txt, Len(txt) - 1)
With Target.Validation
.Delete
.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=txt
End With
End Select
End If

With Sh

.Range("G1").Value = Now
.Range("G1").NumberFormat = "dd mmm yyyy hh:mm:ss"
.Range("H1").Value = Environ("Username")
End With

endprog:
Application.EnableEvents = True
End Sub
Function Worxsheet(ByVal Sh As String, Optional ByRef NewSheet As Boolean = False) As Worksheet
Dim ws As Worksheet
On Error Resume Next
With ThisWorkbook
Set ws = .Worksheets(Sh)
If Err.Number = 9 Then
Set ws = .Worksheets.Add
ws.Move after:=.Worksheets(Sheets.Count)
ws.Name = Sh
NewSheet = True
End If
End With

Set Worxsheet = ws
End Function
Click to expand...
 
Upvote 0
Besides, would you help put the code that forces users to enable macros? Greatly appreciate for your help.
 
Upvote 0
Besides, would you help put the code that forces users to enable macros? Greatly appreciate for your help.
 
Upvote 0
Dave, the code is amazing! Thank you very much.

However, the users who do not enable macros can still see the "Home" worksheet along with some of the worksheets. I don't know why those worksheets are still not very hidden! The code I use is still the same as the above. Please advise how I could make all sheets very hidden even if the macros are disabled.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
ActiveX Checkbox fails after sheetname change
Replies
4
Views
185
bobsan42
bobsan42
T
  • Question
Get Worksheet Bleed Only When Using Freeze Panes
Replies
1
Views
396
Jeffrey Mahoney
Jeffrey Mahoney
M
  • Question
Creating and emailing Excel sheet with only visible data
Replies
0
Views
259
mecerrato
M
L
  • Question
VBA code not working on Mac
Replies
7
Views
652
Jim Gordon
J
E
  • Question
Help Cleaning Up / Optimizing VBA Code
Replies
6
Views
323
offthelip
O

Forum statistics

Threads
1,215,972
Messages
6,128,032
Members
449,414
Latest member
sameri

Share this page

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