User Based Authentication

Kmahraz · Feb 3, 2019

Hello -
I am looking for some assistance,
I would like to Password protect excel sheet shared by multiple users.
I have found this example that I was able to use; but it still doesn't quite meet my needs and was hoping I can get some help.
I would like to set permission for each user password protect excel using VBA. Each User will have access to the certain sheets, based on the level of permission. currently there are 3 levels:
Level 1 : RD - An RD will have access to all sheets with the exception of Data sheet
Level 2 : KM - Represent an Administrator, meaning he can have access to all sheets
Level 3 : BCM - Have access to certain predefined sheets. such as Manager; Profile; local overview; Waterfall; Org Chart; LDA
Attached is a file that has the code and sheets.
any help will be much appreciated,

Regards, @

Fluff13 · Feb 3, 2019

How about something like

Code:

If password <> Me.txtpassword.Value Then
  MsgBox "Invalid Passord"
  Exit Sub
End If
If Me.txtusername.Value = "KM" Then
  Sheets("Manager").Visible = True
  Sheets("Executive").Visible = True
  Sheets("Profile").Visible = True
  Sheets("Initiatives").Visible = True
  Sheets("Local Overview").Visible = True
  Sheets("DAP Overview").Visible = True
  Sheets("DAP support intiatives").Visible = True
  Sheets("Waterfall").Visible = True
  Sheets("Org Chart").Visible = True
  Sheets("LDA").Visible = True
  Sheets("Financials").Visible = True
  Sheets("RD Notes").Visible = True
  Sheets("Manager").Select
ElseIf Me.txtusername = "RD" Then
  Sheets("Manager").Visible = True
ElseIf Me.txtusername = "BCM" Then
  Sheets("LDA").Visible = True

End If

vletm · Feb 3, 2019

Kmahraz
How many users could use in one time that file?
If more than one, then a challenge.

Why You won't use for User Based Authentication
same information as they have already used?
... no need extra 'login' procedure.

One 'note':
If any user write formula like =Profile!A1
to 'own sheet' and drag it down and right ...
user can see everything from that sheet.
no matter of protection.

Kmahraz · Feb 4, 2019

@Fluff13 Thank you so much that did the trick and will help get me moving on my next step.
@vletm you are correct, currently only 4 users, my next project is to work on a shared file that has more users. Will start another thread for that one

.

All sheets now are set to Veryhidden, that will make it a little challenging for any one that doesn't have much experience with VBA - I think

Unless you have other suggestions on how I can increase the protection.

Thank you all!
@

Fluff13 · Feb 4, 2019

You're welcome & thanks for the feedback

vletm · Feb 4, 2019

Kmahraz
It seems that You skipped 'small text':
If any user write formula like =Profile!A1
to 'own sheet' and drag it down and right ...
user can see everything from that sheet.
no matter of protection.
This no need VBA, basic formula!
( and no matter if any sheet is VeryHidden or Visible! )
Even those 'login information' can read as I wrote.
If You would like to 'protect' then that won't work ... sorry.
If You need to 'protect' something,
then that should do other way - not with Excel.
... and many things depends - what are You going to have there?

Kmahraz · Mar 20, 2019

Hello -
This is regarding the same topic.
I made changes to the form and was able to work on a new tool. I found a new VBA code that I would like to use and it meets all my needs with one exception.

Currently ADMIN is able to view all sheets and thats perfect

I am not sure how I can change the code so that :
RD - Has Full access as an ADMIN - with one exception - Cant see sheet "login"
KM - Limited access - Can only view sheet 1, 2 , 3 and 4

Attached is a file that has the code and sheets.
any help will be much appreciated,

Thank you

Fluff13 · Mar 20, 2019

Unfortunately, every time I try to open that file, it crashes xl

Kmahraz · Mar 20, 2019

Hi @Fluff13 - I am not sure why, its working fine for me.
Also, i uploaded a xls one, please see if that works

Here are the two codes

Code:

Public myrole As String
Public lastrow As Double
Private Sub CommandButton1_Click()
Dim myid As String, mypass As String, myrole As String
Dim FindID As Range, ws As Worksheet, t As Double
Application.ScreenUpdating = False
With Me
    myid = .tb_username.Value
    mypass = .tb_password.Value
If Not Len(myid) > 0 Or Not Application.CountIf(Range("user_DB[ID]"), myid) > 0 Then
    MsgBox "Pls input a valid userID.", vbCritical, "ID not found"
.tb_username.SetFocus
Exit Sub
End If
Set FindID = Range("user_DB[ID]").Find(myid)
If FindID.Offset(, 1) <> mypass Then
    MsgBox "Pls input a valid Password.", vbCritical, "Invalid Password"
.tb_password.SetFocus
Exit Sub
End If
End With
With Sheets("login")
    lastrow = Application.CountA(.Columns("I"))
    t = Now
    .Cells(lastrow + 1, "I") = myid
    .Cells(lastrow + 1, "J") = t
End With
myrole = FindID.Offset(, 2)
MsgBox "Welcome" & vbTab & myrole & vbTab & myid, vbInformation, "Welcome"
If myrole = "Admin" Then
    For Each ws In ThisWorkbook.Sheets
        If ws.Visible <> -1 Then ws.Visible = -1
    Next
End If
If myrole = "RD" Then
    For Each ws In ThisWorkbook.Sheets
        If ws.Visible <> -1 Then ws.Visible = -1
    Next
End If
Unload Me
Sheets("Welcome").[A1].Value = "Access Granted to " & myid & " @ " & Format(t, "DD-MM-YYYY hh:mm:ss")
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _
  CloseMode As Integer)
  Dim Q As Variant
  If CloseMode = vbFormControlMenu Then
    Q = MsgBox("Are you sure as xl will get closed.", vbExclamation + vbYesNo, "Confirm the action")
        If Q = vbNo Then Cancel = True: Exit Sub
      
Application.ScreenUpdating = False
Application.WindowState = xlMinimized
Unload Me
ThisWorkbook.Close True
End If
Application.ScreenUpdating = True
End Sub

Second Code

Code:

Public lastrow As Double
Sub LogOut_ME()
Application.ScreenUpdating = False
With Sheets("login")
    lastrow = Application.CountA(.Columns("I"))
  .Cells(lastrow, "K") = Now
End With
For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "Welcome" Then ws.Visible = 2
Next
If ActiveSheet.Name <> "Welcome" Then Sheets("Welcome").Activate
Sheets("Welcome").[A1].Value = "Pls login To Continue"
With Sheets("Welcome").Shapes("Picture 1")
    .Left = 975
    .Top = 75
End With
LOGIN.Show 0
Application.ScreenUpdating = True
End Sub

Code:

Private Sub Workbook_Open()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "Welcome" And ws.Visible <> 2 Then ws.Visible = 2
Next
LOGIN.Show 0
Application.WindowState = xlMaximized
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
Application.WindowState = xlMinimized
For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "Welcome" Then ws.Visible = 2
Next
If ActiveSheet.Name <> "Welcome" Then Sheets("Welcome").Activate
Sheets("Welcome").[A1].Value = "Pls login To Continue"
With Sheets("login")
    lastrow = Application.CountA(.Columns("I"))
  .Cells(lastrow, "K") = Now
End With
ThisWorkbook.Close True
End Sub

Fluff13 · Mar 20, 2019

Same problems, could you upload it as an xlsx file.

Kmahraz · Mar 20, 2019

Let me know if this one work,

Thank you

Fluff13 · Mar 20, 2019

Ok, try

Code:

Private Sub CommandButton1_Click()
Dim myid As String, mypass As String, myrole As String
Dim FindID As Range, ws As Worksheet, t As Double

Application.ScreenUpdating = False
With Me
    myid = .tb_username.Value
    mypass = .tb_password.Value

If Not Len(myid) > 0 Or Not Application.CountIf(Range("user_DB[ID]"), myid) > 0 Then
    MsgBox "Pls input a valid userID.", vbCritical, "ID not found"
.tb_username.SetFocus
Exit Sub
End If

Set FindID = Range("user_DB[ID]").Find(myid)

If FindID.Offset(, 1) <> mypass Then
    MsgBox "Pls input a valid Password.", vbCritical, "Invalid Password"
.tb_password.SetFocus
Exit Sub
End If

End With

With Sheets("login")
    lastrow = Application.CountA(.Columns("I"))
    t = Now
    .Cells(lastrow + 1, "I") = myid
    .Cells(lastrow + 1, "J") = t
End With

myrole = FindID.Offset(, 2)

MsgBox "Welcome" & vbTab & myrole & vbTab & myid, vbInformation, "Welcome"
  Select Case FindID
      Case "Admin"
        For Each ws In ThisWorkbook.Sheets
            If ws.Visible <> -1 Then ws.Visible = -1
        Next
      Case "KM"
        For Each ws In Sheets(Array("Sheet1", "sheet2", "Sheet3", "sheet4"))
            If ws.Visible <> -1 Then ws.Visible = -1
        Next
      Case "RD"
        For Each ws In ThisWorkbook.Sheets
            If ws.Name <> "login" Then
              If ws.Visible <> -1 Then ws.Visible = -1
            End If
        Next
  End Select
Unload Me

Sheets("Welcome").[A1].Value = "Access Granted to " & myid & " @ " & Format(t, "DD-MM-YYYY hh:mm:ss")

Application.ScreenUpdating = True
End Sub

Kmahraz · Mar 20, 2019

Thank you so much @Fluff13 , this works with one exception
When I run the macro and select "Admin" the only sheet that become visible is "Welcome"

Fluff13 · Mar 20, 2019

Change

Code:

 Case "Admin"

to

Code:

 Case "ADMIN"

Kmahraz · Mar 20, 2019

Sorry I am not sure I understand which line I should change

"Admin" Able to see and access all sheets
"RD" Able to see and access all sheets with the exception of sheet "Login"
"KM" Able to see and Access only certain sheets (1,2,3 and 4)

Fluff13 · Mar 20, 2019

You need to change the line I showed and change Admin to ADMIN (ie all upper case)

Kmahraz · Mar 20, 2019

For some reason the second line you posted was not showing in my screen... That did the trick and solved the issue

I will update my sheets and keep you posted should I encounter any roadblock

Thank you so much again

Fluff13 · Mar 20, 2019

You're welcome & thanks for the feedback

User Based Authentication

Member

Attachments

Active Member

Excel Ninja

Member

Active Member

Excel Ninja

Member

Attachments

Active Member

Member

Attachments

Active Member

Member

Attachments

Active Member

Member

Active Member

Member

Active Member

Member

Active Member