Require VBA code to user form with hidden sheet feauture

[brightwayhr]

Hi ,

The login form should have access to multiple admin and sub user, Where the admin can give access only to few sheets to there sub user for editing and other sheet has to be hidden.

I require VBA code.

 

[Rhodie72]

Hi ,

The login form should have access to multiple admin and sub user, Where the admin can give access only to few sheets to there sub user for editing and other sheet has to be hidden.

I require VBA code.

There's an idea in there somewhere but it's not clear. Could you please explain your idea in point form?

Example:
1) I have 7 sheets in a workbook named "restricted access.xlsx"
2) Admin can access all sheets but user access restricted to sheets 1,4 and 11

Can you design a form that pops up and for Admin whenever the (workbook is opened/macro runs/user selects restricted sheet) to allow the Admin to unlock access to (a specific sheet/ group of sheets/ remove access restrictions completely)?

 

[brightwayhr]

Hi thanks for making the points very clear, exactly am looking for the same sheet as example mentioned above. Still I want to make it very clearly I'll brief in points.

Example:

When I open an workbook named as Revenue Tracker, it has to pop up with the user form login where the user has to enter username and password.

Admin: Admin should have all previleges to view all sheets example if a workbook contains 12 sheets admin can view.

Sub user: Admin should have acces to generate or include sub user where the access to to sheet is limited example subuser should have access to view only sheet 2 ,3 ,and 4 and other pages have to be hidden.

Adding to this advance Filter:

If the sheet 1 named Employee tracker all details about employee and there team are maintained in a sheet and in N row there are different Team, Example Team A , Team B , Team C, when the Team A or B sub user login to sheet the data of Team A should filter and paste in new sheet.

Team A should see only Team A data
Team B should see only Team B data other sheets have to be hidden.

 

[Rhodie72]

Looking at the requirements and thinking them through it appears that the level of security should be handled by the operating system file security. The way that you want this set up seems to be along that level of management. Although you register for 2 security groups, you actually want 3. These grades are:

1) Super User
Super users are administrators who manage user groups, file permissions (Read, Write, View, Modify, et.c.)

2) Power User
Power users would be people like supervisors who have delegated responsibilities or special access needs that are greater than ordinary users

3) User
Usually has restricted rights that allow read, write & modify their own files, but cannot view restricted content.

If this is the model you aim at, then VBA may be a blunt instrument when you already can set this up without programming a thing:

Separate your team worksheets into their own workbooks with links back to the main source workbook. All permissions administration can be managed by your network according to the folders that the files reside in. VBA is not very secure and anybody who knows a little about it could easily bypass the security unless you've got strict "system policy enforcement" in place.

 

[brightwayhr]

Will I get code for this one.

 

[mikerickson]

I'm at work right now, but when I get home, I'll post the code that I've written for this situation.

 

[mikerickson]

Let me start by saying that Excel is not a secure platform. VBA driven password code like this is not secure and can be easily overcome by any one with moderate VBA knowledge. Routines like this are good only for controlling access of willing users. Malevolent people can get past this in a trice.


Your requirement that certain users have access to different ranges in the same sheet made things a bit more complicated.

First, you need to set up your worksheet.
There has to be a sheet called Home, that will be always visible for all users.
There also has to be a sheet called Users, that will be visible only to admin. This sheet will hold the list of all users, their passwords and the sheet access that they have.
(You have to adjust the functions PassDataSheet and HomeSheet in the user form's code module.)

This is the test data that I used in my Users sheet.

Unknown
	A	B	C	D	E	F	G
1	Users	Password	Home	Users	Shared	Jane's Sheet	Bob's Sheet
2	admin	admin
3	Bob	BobPW		FALSE	1:10	FALSE
4	Jane	JanePW		FALSE	11:20		FALSE
Users

The workbook has 5 sheets, Home, Users, Shared, Bob's Sheet and Jane's Sheet. All the workbooks sheets should be in row 1 of the Users sheet.

There are three users: admin, Bob and Jane. Their case sensitive passwords are next to their names.

Looking down admin's row, we see that admin has access to all of all of the sheets (blank means "all access")

Bob has access to all of Home, no access to Users, access to rows 1:10 of Shared, no access to Jane's Sheet and access to all of Bob's Sheet

Jane has access to all of Home and Jane's Sheet, none to Users or Bob's Sheet, and to rows 11:20 of shared.

Partial access to a sheet is indicated by the range that the user has access to.
Discontinuous ranges are allowed, but work best with whole row or whole column areas (e.g. 1:1,10:20 vs A1:D4,E8:G10)

UserNames are case insensitive and should be unique
Passwords are case sensitive.

This is implemented through a user form, Userform1.

The code in the user form is

' in useform code module

Private Function PassDataSheet() As Worksheet
    Set PassDataSheet = Sheet2: Rem adjust
End Function

Private Function HomeSheet() As Worksheet
    Set HomeSheet = Sheet1: Rem adjust
End Function

Private Sub CommandButton1_Click()
    If Me.Tag = vbNullString Then
        Unload Me
    Else
        Me.Hide
    End If
End Sub

Private Sub UserForm_Initialize()
    Rem can be set at design time
    With Label1
        .Width = 300
        .WordWrap = False
        .Caption = "UserName"
        .AutoSize = True
    End With
    With Label2
        .Width = 300
        .WordWrap = False
        .Caption = "Password (case sensitive)"
        .AutoSize = True
    End With
    With Label3
        .Width = 200
        .WordWrap = False
        .Caption = "Enter username and password"
    End With
    With CommandButton1
        .Caption = "Submit"
        .TakeFocus******* = True
    End With
    With TextBox1
        .EnterFieldBehavior = fmEnterFieldBehaviorSelectAll
        .EnterKeyBehavior = False
        .TabKeyBehavior = False
    End With
    With TextBox2
        .EnterFieldBehavior = fmEnterFieldBehaviorSelectAll
        .EnterKeyBehavior = False
        .TabKeyBehavior = False
        .PasswordChar = Chr(165)
    End With
    Rem end design time properties
    TextBox1.Text = vbNullString
    Call HideAll
    
End Sub

Public Function SubmitPassword() As Boolean
    Dim uiUserName As String, uiPassword As String
    Dim strPrompt As String
    Dim userData As Range
    Dim oneRng As Range, oneSheet As Worksheet
    Dim AttemptCount As Long
    AttemptCount = 3
    
    Me.Tag = "active"
    Label3.Caption = "Enter username and password"
    Me.Caption = TextBox1.TabKeyBehavior
    Do
        TextBox2.Text = vbNullString
        Me.Show
        AttemptCount = AttemptCount - 1
        With UserForm1
            If .Tag <> vbNullString Then
                uiUserName = TextBox1.Text
                uiPassword = TextBox2.Text
                Set userData = PassDataSheet.Columns(1).Find(what:=uiUserName, MatchCase:=False)
                If userData Is Nothing Then
                    Label3.Caption = "No such user"
                    Label3.Caption = Label3.Caption & vbCr & AttemptCount & " attempts remain."
                    Label3.Caption = Label3.Caption & vbCr & vbCr & "Enter UserName and Password"
                Else
                    Set userData = userData.EntireRow
                    If userData.Cells(1, 2) = uiPassword Then
                        SubmitPassword = True
                        Exit Do
                    Else
                        Label3.Caption = "Wrong password"
                        Label3.Caption = Label3.Caption & vbCr & AttemptCount & " attempts remain."
                        Label3.Caption = Label3.Caption & vbCr & vbCr & "Enter UserName and Password"
                    End If
                End If
            Else
                Exit Do
            End If
        End With
    Loop Until AttemptCount <= 0
    If SubmitPassword Then
        HomeSheet.Visible = xlSheetVisible
        On Error Resume Next
        With PassDataSheet
            For Each oneRng In Range(.Cells(1, 3), .Cells(1, .Columns.Count).End(xlToLeft))
                ViewStatus(ThisWorkbook.Sheets(oneRng.Value)) = Application.Intersect(userData, oneRng.EntireColumn).Value
            Next oneRng
        End With
        On Error GoTo 0
    Else
        Rem bad password
        HomeSheet.Visible = xlSheetVisible
        For Each oneSheet In ThisWorkbook.Worksheets
            ViewStatus(oneSheet) = (oneSheet.Name = "Home")
        Next oneSheet
    End If
    Application.ScreenUpdating = True
    Unload UserForm1
End Function

Public Sub HideAll()
    Dim oneSheet As Worksheet
    HomeSheet.Visible = xlSheetVisible
    For Each oneSheet In ThisWorkbook.Worksheets
        ViewStatus(oneSheet) = (oneSheet.Name = "Home")
    Next oneSheet
    Application.ScreenUpdating = True
End Sub

Property Get ViewStatus(aSheet As Worksheet) As Variant
    ViewStatus = aSheet.Visible = xlSheetVisible
End Property
Property Let ViewStatus(aSheet As Worksheet, inVal As Variant)
    Dim HideSheet As Boolean
    Dim ViewRange As Range
    Dim ScrollRange As Range
    Dim oneRng As Range
    Application.ScreenUpdating = False
    Select Case LCase(inVal)
        Case "all", "yes", "true", xlSheetVisible
            inVal = ""
        Case "none", "no", "false", xlSheetHidden, xlSheetVeryHidden
            HideSheet = True
            inVal = "A1"
    End Select
    With aSheet
        If HideSheet Then
            .Cells.EntireColumn.Hidden = True
            .Cells.EntireRow.Hidden = True
            .ScrollArea = "A1"
            .Visible = xlSheetVeryHidden
        Else
            .Visible = xlSheetVisible
            .Cells.EntireColumn.Hidden = False
            .Cells.EntireRow.Hidden = False
            If inVal = vbNullString Then
                .ScrollArea = vbNullString
            Else
                Set ViewRange = .Range(inVal)
                Set ScrollRange = ViewRange.Areas(1)
                For Each oneRng In ViewRange.Areas
                    Set ScrollRange = Range(ScrollRange, oneRng)
                Next oneRng
                
                For Each oneRng In ScrollRange.Rows
                    If Application.Intersect(oneRng, ViewRange) Is Nothing Then
                        oneRng.EntireRow.Hidden = True
                    End If
                Next oneRng
                
                If ScrollRange.Column > 1 Then
                    Range(.Range("A1"), ScrollRange.Cells(1, 1).Offset(0, -1)).EntireColumn.Hidden = True
                End If
                If ScrollRange.Row > 1 Then
                    Range(.Range("A1"), ScrollRange.Cells(1, 1).Offset(-1, 0)).EntireRow.Hidden = True
                End If
                If ScrollRange.Column + ScrollRange.Columns.Count < .Columns.Count Then
                    Range(ScrollRange.Cells(1, 1).Offset(0, ScrollRange.Columns.Count), .Cells(.Columns.Count, .Columns.Count)).EntireColumn.Hidden = True
                End If
                If ScrollRange.Row + ScrollRange.Rows.Count < .Rows.Count Then
                    Range(ScrollRange.Cells(1, 1).Offset(ScrollRange.Rows.Count, 0), .Cells(.Rows.Count, .Columns.Count)).EntireRow.Hidden = True
                End If
                .ScrollArea = ScrollRange.Address
            End If
        End If
    End With
End Property

And you should put this code in the ThisWorkbook code module.

' in ThisWorkbook code module

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Unload UserForm1
    If Me.Saved Then Me.Save
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Unload UserForm1
End Sub

Private Sub Workbook_Open()
    UserForm1.SubmitPassword
End Sub

And in a normal module

' in normal module

Sub ChangeUser()
    UserForm1.SubmitPassword
End Sub

 

[Rhodie72]

mikerickson stated correctly that Excel security is lax

My personal preference for hiding security information is in the registry because this is more difficult to navigate and also editable from a remote location. It also means you can hide the information away from the users even in a networked environment which restricts any security breaches to those who aer extreley knowledgable about computers and Excel. Not only that, you have to ensure that you lock the project against viewing so nobody sees where the destination data goes and even if they saw the source code would probably not understand it straight away as you can encrypt/decrypt/modify the passwords so they have user/admin/poweruser keys added to them that is decoded by the VBA cod at runtime. This security aspect is the same issue I face whilst producing a new software application for Excel for commercial sale.

You have to decide how secure you want your data to be. If it is for casual security that is not part of Data Protection Law then Excel is fine but if you have to ensure that it meets or exceeds legal requirements, Excel is NOT the solution and you need to separate the data in the sheets to separate workbooks

 

[brightwayhr]

Hi Mike,

Thanks for the code.

Am getting an error

Run-time error '424':


Object required

Tried Debug an error
in this workbook code is

UserForm1.SubmitPassword

 

[mikerickson]

Did you create the user form as described and put that code into it?