Passwords and Auto Filters - xl97

[Babydum]

Hi

I have a tricky problem regarding filters and passwords.

What I would like to do is to create a hidden list of users and passwords (I can do this). Then, when the spreadsheet is opened, an input box will ask for the user’s name and password and check it against my list. If the password is wrong it will throw them out of the workbook.

If the password is correct, when they attempt to use a filter on Column C, the only name they will be allowed to choose is their own.

I do not know how to create input boxes, nor how to check the entry against my hidden list, nor how to force the filter to show only one name. So any help on any of these aspects would be much appreciated.

 

[Glaswegian]

I would suggest a UserForm - it's easier to customise to what you need. Create a user form in the VB Editor. On the form draw 2 textboxes, 2 labels - one called 'User Name' and one called 'Password' - and 2 command buttons - one called 'submit' and one called 'cancel'. Highlight the password textbox and from the Menu Bar click on View > Properties Window. Scroll down the list of properties until you see a field called 'PasswordChar'. In the blank field to the right, input a character - this is the character that will appear in the textbox and will 'mask' the real password. Most people choose * but it can be anything you like. Now double click on the command button called 'submit' and paste in this code

Private Sub CommandButton1_Click()

On Error GoTo errhandle
Set logName = Sheets("Sheet1").Range("A1:A100").Find(TextBox1)

If TextBox1 = "" Then
MsgBox "A valid username is required"
End If
If Not logName Is Nothing Then
If Sheets("Sheet1").Range("B1:B100").Find(TextBox2) = TextBox2 Then
MsgBox "Welcome - Log in successful"
Sheets("Sheet2").Select
Me.Hide
Sheets("Sheet2").Range("C2").AutoFilter field:=1, Criteria1:=logName
Else: MsgBox "Invalid Password - please try again"
TextBox2.Text = ""
End If
End If
Exit Sub
errhandle:
MsgBox "Invalid Username - please try again"
TextBox1.Text = ""
TextBox2.Text = ""
End Sub

Go back to the userform and double click on the command button called 'cancel' and paste in this code

Private Sub CommandButton2_Click()
UserForm1.Hide
ThisWorkbook.Close savechanges:=False
End Sub


and then this code

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Please use the Submit or Cancel buttons", vbCritical
Cancel = True
End If
End Sub


Now double click on ThisWorkbbok module and paste in this

Private Sub Workbook_Open()
Sheets("Sheet3").Select
UserForm1.Show
End Sub


The last piece of code will cause the password form to appear when the workbook opens. The first piece of code checks the username and password against your list - I've assumed that the username is in column A and the password is in column B and the correct password is against the relevant username. I've added some error checking for misspelt names and passwords and users clicking submit without a username. If all is OK then the user goes to another sheet where your list is and the Autofilter is set based on their username. The Query Close code is in case a user tries to close the form by clicking on the 'X' at the top right corner.

Some things to note: change your sheet names as required. The autofilter requires a heading row with the list of user names below. I've filtered on column C as you stated in your post. If the user clicks the 'cancel' button then the workbook closes and no changes are saved. I've set the code to check passwords and usernames in only a few rows - change the range reference as required.

This is not perfect but hopefully will give you a few ideas.

HTH

Regards

 

[Babydum]

Iain,

Thanks so much for this code. Your clear and easy instruction will benefit me in a host of different ways, because I have a better understanding now of how userforms work.

However, when I run this code, the password box just stays there. I can't get rid of it unless I click cancel - but this closes the w/book. Any ideas?

Thanks so much for your help with this - and sorry for the delay in responding.

 

[Glaswegian]

Hi D

Try this version. I partly wrote the code at home so there were some difference with XL97.

Private Sub CommandButton1_Click()
Dim logName As Range
Dim pWord As Range

On Error GoTo errhandle
Set logName = Sheets("Sheet1").Range("A1:A100").Find(TextBox1)
Set pWord = Sheets("Sheet1").Range("B1:B100").Find(TextBox2)
If TextBox1 = "" Then
MsgBox "A valid username is required"
End If
If Not logName Is Nothing Then
If Not pWord Is Nothing Then
If pWord = logName.Offset(0, 1) Then
MsgBox "Welcome - Log in successful"
Sheets("Sheet2").Select
Me.Hide
Sheets("Sheet2").Range("C2").AutoFilter field:=1, Criteria1:=logName
End If
Else
MsgBox "Invalid Password - please try again"
TextBox2.Text = ""
End If
End If
Exit Sub
errhandle:
MsgBox "Invalid Username - please try again"
TextBox1.Text = ""
TextBox2.Text = ""
End Sub

HTH

Regards

 

[Babydum]

Hi Iain,

Unfortunately, this does not work either, on the one hand, it sits there if I put a valid user name in, on the other - if left blank it lets me in after a warning message.

I'm stumped!

 

[Glaswegian]

D

I've just checked - works fine for me. Check your ranges and sheet names, especially where the usernames and passwords are stored. I put usernames and passwords on sheet1, columns A and B - did you do the same? (although I appreciate your setup is probably different.)

Regards

 

[Glaswegian]

Slight tweak (got my Ifs and Elses in the wrong place) - apologies.

Private Sub CommandButton1_Click()
Dim logName As Range
Dim pWord As Range

On Error GoTo errhandle
Set logName = Sheets("Sheet1").Range("A1:A100").Find(TextBox1)
Set pWord = Sheets("Sheet1").Range("B1:B100").Find(TextBox2)
If TextBox1 = "" Then
MsgBox "A valid username is required"
End If
If Not logName Is Nothing Then
If Not pWord Is Nothing Then
If pWord = logName.Offset(0, 1) Then
MsgBox "Welcome - Log in successful"
Sheets("Sheet2").Select
Me.Hide
Sheets("Sheet2").Range("C2").AutoFilter field:=1, Criteria1:=logName
End If
Else
MsgBox "Invalid Password - please try again"
TextBox2.Text = ""
End If
Else
MsgBox "A valid username is required"
TextBox1 = ""
End If
Exit Sub
errhandle:
MsgBox "Invalid Username - please try again"
TextBox1.Text = ""
TextBox2.Text = ""
End Sub


See how that works.

Regards

 

[Glaswegian]

I think senility is approaching faster than I realised.

I have tested this for all combinations of correct and incorrect usernames and passwords - it works. I don't normally like using GoTo but I won't have a chance to produce anything better at the moment.

Private Sub CommandButton1_Click()
Dim logName As Range
Dim pWord As Range

On Error GoTo errhandle
Set logName = Sheets("Sheet1").Range("A1:A100").Find(TextBox1)
Set pWord = Sheets("Sheet1").Range("B1:B100").Find(TextBox2)
If TextBox1 = "" Then
    GoTo errhandle
End If
    If Not logName Is Nothing Then
        If Not pWord Is Nothing Then
            If pWord = logName.Offset(0, 1) Then
                MsgBox "Welcome - Log in successful"
                Sheets("Sheet2").Select
                Me.Hide
                Sheets("Sheet2").Range("C2").AutoFilter field:=1, Criteria1:=logName
                Exit Sub
            End If
            Else
            GoTo errhandle
        End If
            Else
            GoTo errhandle
    End If
    GoTo errhandle
Exit Sub
errhandle:
MsgBox "Invalid details - please try again"
TextBox1.Text = ""
TextBox2.Text = ""
End Sub

Regards

 

[Babydum]

Thanks Iain,

That's much better - it kicks you out if you don't get it right - and it lets you in if you do. One final nitpick though. After the "Welcome, login successful" message, it then says "invalid user name" - (though it doesn't prevent me from going in)

Thanks again.

 

[Glaswegian]

Hi D

You've got me there - I don't get that message - just the 'Welcome'. Seems to be OK?

Regards