Restrict Access per user

[Chiragshah15]

Hi,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I wanted to build some VBA code to restrict what a user can see based on their user ID. <o></o>
<o></o>
I am deciding on whether to use a pivot table with slicers to create the restrictions or drop down boxes.<o></o>
<o></o>
Can anyone suggest any useful code or sites?<o></o>
<o></o>
Thanks,<o></o>

 

[SteveO59L]

As a workbook_open event, use environ("username") to specify what details a user can access

 

[Biz]

Try code below. Does it help?

Sub Test()
'_________________________________________
'   Test UserName authorisation
    Dim objNet As Object
    Dim Msg As String
    'Dim C As Range, aRange As Range, aCell As Range
 
    On Error Resume Next
    Set objNet = CreateObject("WScript.NetWork")
      Select Case objNet.UserName
        Case Is = "bSmith", "jsmith", "super" '<==== UserName Access
 
  'Access granted add your code and action
 
 
        Case Else
          MsgBox "Access Is Denied " & objNet.UserName
      End Select
 
End Sub

 

[Chiragshah15]

Great thank you,

works well, you know that as you have given me some help I will need to ask you for more?

I have a list of people that I wanted to give access to. There access is determined by a filter on cell a1 (basically thier user name)

e.g

If Chris Dawes (Dawesc) opens the excel spreadsheet the filter will only select his name.

So far I have got the code below, but I see it more unmanageable if I have many users, would it be possible to lookup the user on a lst in the workbook?

On Error Resume Next
Set objNet = CreateObject("WScript.NetWork")
Select Case objNet.UserName
Case Is = "bSmith", "jsmith", "shahca" '<==== UserName Access

'Access granted add your code and action
Sheets("pivot").Visible = True
ActiveSheet.Range("$A$1:$at$5").AutoFilter Field:=1, Criteria1:=objNet.UserName
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
ActiveSheet.Name = objNet.UserName
Sheets("pivot").Visible = False

MsgBox "Report created for " & objNet.UserName

Case Else
MsgBox "Access Is Denied " & objNet.UserName
End Select

End Sub

 

[Biz]

Try code below

AccessList is ranged name where you define userid you want access granted for.

Sub test()
'Test UserName authorisation
    Dim objNet As Object
    Dim Msg As String
    Dim iBoolean As Boolean
    Dim i As Long
   
   
On Error Resume Next
Set objNet = CreateObject("WScript.NetWork")
iBoolean = False
 
iBoolean = Application.IsNumber(Application.Match(CStr(objNet.UserName), Range("AccessList"), 0))
'MsgBox iBoolean, vbInformation
Select Case iBoolean = True
Case True:
'Access granted add your code and action
Sheets("pivot").Visible = True
ActiveSheet.Range("$A$1:$at$5").AutoFilter Field:=1, Criteria1:=objNet.UserName
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
ActiveSheet.Name = objNet.UserName
Sheets("pivot").Visible = False
MsgBox "Report created for " & objNet.UserName
Case False:
MsgBox "Access Is Denied " & objNet.UserName
End Select
End Sub

Does it help?

Biz

 

[Smitty]

Welcome to the Board!

If you PM me your e-mail address I'll send you a workbook that does what you want. A few of us put it together several years ago for another board member, and it's been floating around ever since.