How to create and manage user access

[waimea]

I am trying to create a system to manage user access in VBA.

I have a login form with a login script, I have a logout script but I would also like the possibility to store settings and preferences.

Users is a worksheet with column B for username, column C for the password, column D for admin (admin = TRUE, not admin = FALSE).

I want to make sure that an user can't get access to my file without having a username and a password.

At the moment I only have settings for toggle fullscreen that I would like to save between user sessions but I am thinking about the possibility to hide/show worksheets based on user level or admin level.

How can I improve this code? I would like to create a framework in some way that connects with my other code which is lots of small subs. I have an userform that allows me to hide or show worksheets and I would like to connect that userform to my framework if possible?

Public check As Boolean


Private Sub LogIn_Click()
    'Dim username As String
    Dim Password As String
    Dim passWs As Worksheet
    Dim lRow As String
    Dim rng As range
    Dim CorrectDetails As Boolean
    Dim i As Integer
    
    Username = Me.Username.Value
    
    Password = Me.Password.Text
    
    If Len(Trim(Username)) = 0 Then
        Me.Username.SetFocus
        MsgBox "Please enter your username", vbOKOnly, "Username"
        Exit Sub
    End If


    If Len(Trim(Password)) = 0 Then
        Me.Password.SetFocus
        MsgBox "Please enter your password", vbOKOnly, "Password"
        Exit Sub
    End If


    Set passWs = ThisWorkbook.worksheets("Users")


    With passWs
        lRow = .range("B" & .Rows.Count).End(xlUp).Row


        For i = 1 To lRow
            If UCase(Trim(.range("B" & i).Value)) = UCase(Trim(Username)) Then 'Username Check
                If .range("C" & i).Value = Password Then 'Password Check
                    CorrectDetails = True
                                                       
                    'Sheets("Start").Activate


                    ' Admin is True                 
                    Sheets("Admin").Visible = True
                    Sheets("Admin").Activate
                    check = True
                    
                    If Username.Value <> "" Then
                        On Error Resume Next
                       
                        Sheets("Start").Shapes("LoggedIn").TextFrame.Characters.Text = "Logged In as " & Username.Value


                        End If
                        Me.Hide
                        Unload Me
                                                            
                    If .range("D" & i).Value = "True" Then
                   


                     End If


                      'Admin is false
                     Else
                        Sheets("Start").Activate
                        check = True
                                                
                        If Username.Value <> "" Then
                        
                        On Error Resume Next
                        
                        Sheets("Start").Shapes("LoggedIn").TextFrame.Characters.Text = "Logged In as " & Username.Value
                       
                        End If
                        Unload Me
                                               
                    End If


                    Exit For
                End If
            End If
        Next i


        'Incorrect Username/Password
        If CorrectDetails = False Then
            MsgBox "Wrong username and/or password"
        End If
    End With
End Sub


Private Sub Close_Click()
    'Unloads the form
    check = True
    Unload Me
    ActiveWorkbook.Close True
End Sub




Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If check = False Then
    MsgBox "Please enter your username and password", vbCritical
    Cancel = True
End If
End Sub

Sub LogOut()


Dim result As String
result = MsgBox("Hi, " & Application.Username & " Save and exit?", vbYesNo + vbQuestion)


If result = vbYes Then ' Logs out user


    On Error Resume Next
    Sheets("Start").Shapes("LoggedIn").TextFrame.Characters.Text = "Logged In as "
    
    On Error Resume Next
    
    ActiveWorkbook.Save
    ActiveWorkbook.Close , True


Else:


End If
End Sub

Sub ToggleFullScreeen()
  
    Application.DisplayFullScreen = Not Application.DisplayFullScreen
    
    With Application.ActiveWindow
        .DisplayHeadings = Not .DisplayHeadings
        .DisplayWorkbookTabs = Not .DisplayWorkbookTabs
    End With
End Sub

[waimea]

If possible the framework/code could use listobjects? I store all data in tablels and I calculate the average, standard deviation of the table columns and store that information in another table.

I like the idea of looping through list objects.

And have one admin sheet where the admin can control user settings, file settings, perhaps saved comments, the possiblity to email etc?

[snb]

Forget all this.
No need to trouble a user with what (s)he already did: logging in in Windows.
So use the windows username.

Use in the event Workbook open:

Sub Workbook_open()
   if envrion("username")<>"snb" then thisworkbook.close 0
End Sub

[waimea]

I don't understand your code. If windows username isn't "snb" then workbook close?

I guess I could change my shapes with text in them to show environ("username"). I also guess application.username is unnecessary?

How would you save settings for a user?

[waimea]

I need a multiuser login for my workbook.

When I say framework I am thinking of writing code that:

1. Creates a login for multiple users
2. Places collection of shapes into all visible sheets and assigns the correct macro to each shape
3. Shows the username in all visible sheets
4. Saves settings for the user about fullscreen yes or no. And more options as the need arrives
5. Has the ability to show different sheets to different user levels
6. Logout and save settings for next workbook open

If we start with 1. I have a user form that is working and I want to improve the code for the login part but I am not sure how.

Public check As Boolean


Private Sub LogIn_Click()
    'Dim username As String
    Dim Password As String
    Dim passWs As Worksheet
    Dim lRow As String
    Dim rng As range
    Dim CorrectDetails As Boolean
    Dim i As Integer
    
    Username = Me.Username.Value
    
    Password = Me.Password.Text
    
    If Len(Trim(Username)) = 0 Then
        Me.Username.SetFocus
        MsgBox "Please enter your username", vbOKOnly, "Username"
        Exit Sub
    End If




    If Len(Trim(Password)) = 0 Then
        Me.Password.SetFocus
        MsgBox "Please enter your password", vbOKOnly, "Password"
        Exit Sub
    End If




    Set passWs = ThisWorkbook.worksheets("Users")




    With passWs
        lRow = .range("B" & .Rows.Count).End(xlUp).Row




        For i = 1 To lRow
            If UCase(Trim(.range("B" & i).Value)) = UCase(Trim(Username)) Then 'Username Check
                If .range("C" & i).Value = Password Then 'Password Check
                    CorrectDetails = True
                                                       
                    'Sheets("Start").Activate




                    ' Admin is True                 
                    Sheets("Admin").Visible = True
                    Sheets("Admin").Activate
                    check = True
                    
                    If Username.Value <> "" Then
                        On Error Resume Next
                       
                        Sheets("Start").Shapes("LoggedIn").TextFrame.Characters.Text = "Logged In as " & Username.Value




                        End If
                        Me.Hide
                        Unload Me
                                                            
                    If .range("D" & i).Value = "True" Then
                   




                     End If




                      'Admin is false
                     Else
                        Sheets("Start").Activate
                        check = True
                                                
                        If Username.Value <> "" Then
                        
                        On Error Resume Next
                        
                        Sheets("Start").Shapes("LoggedIn").TextFrame.Characters.Text = "Logged In as " & Username.Value
                       
                        End If
                        Unload Me
                                               
                    End If




                    Exit For
                End If
            End If
        Next i




        'Incorrect Username/Password
        If CorrectDetails = False Then
            MsgBox "Wrong username and/or password"
        End If
    End With
End Sub




Private Sub Close_Click()
    'Unloads the form
    check = True
    Unload Me
    ActiveWorkbook.Close True
End Sub








Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)


If check = False Then
    MsgBox "Please enter your username and password", vbCritical
    Cancel = True
End If
End Sub

[Rob342]

Hi Waimea

I use a multiuser form for this type of login, can you post a copy of your workbook ?
and I take a look

Rob

[waimea]

Hi Rob,

thank you for your reply! I can't post a copy of my workbook but I did a quick mockup that I'll work some more on and then upload.

I would like to create code that keeps track of the logged in user in all worksheets, keeps track of settings and preferences. I have most of the functionality I guess but I think there is a lot to improve on.

I am thinking of creating the shapes with a macro and then positioning them vs. creating them in the workbook and then use VBA to place them in the correct place.

All suggestions are welcome.

[Rob342]

Hi Waimea

Have created a Login User Form very quickly
Password for Prompt Sheet = 1234
Password for Administrator = 20313
The form is mondal so you can't close it accidently but that can be changed depending on what you want to hide
All the sheets are hidden at the moment but you can change that or add it to the user by password

See what you think
Rob

[waimea]

Hi Rob 342, thank you for your reply!

Your form is impressive and I am going to look at the code and learn how you coded the different functions!