Help with macro used to open files - unpredictable results!

[Monomeeth]

Hello

I have been trying to use a macro to allow users to open their own
personalised logs which are password protected. Users click on a button and
then the macro asks for their User ID. After entering their User ID the macro
then asks for their password. If the password is correct, the macro then
opens that user's individual file.

For this to work, the macro reads data from a hidden worksheet. This hidden
worksheet has data in three columns: A, B and C. The first column contains
the User ID, the second column contains passwords, and the third column
contains the full file path.

The problem I have is this: The hidden worksheet has details for 64 users,
but the macro only recognises 14 of these users. As a result, these users
cannot open their files. I am at a total loss to explain why. It makes no
difference what order the users are listed within the hidden worksheet, and
there is no obvious pattern to either those users who are recognised or those
who aren't. I really am at a total loss.

Any help would be greatly appreciated as I need this for work on Monday.

Thanks.


The macro code is below:

Sub FindStaff()
Dim FoundCell As Range
Dim ws1 As Worksheet
Dim Search As Variant
Dim Passwrd As Variant
Dim MyFile As String
Dim MyTitle As String
Dim OpenWB As Workbook

Set ws1 = Worksheets("Users") '<< change as required

MyTitle = "Open My WorkBook"

startsearch:
Search = Application.InputBox(prompt:="User ID",
Title:=MyTitle, Type:=2)


If Search = False Then Exit Sub

'search for staff number
Set FoundCell = ws1.Columns("A").Find _
(Search, LookIn:=xlValues, _
LookAt:=xlWhole)

If FoundCell Is Nothing = False Then

i = 1
enterpassword:
Passwrd = Application.InputBox(prompt:="Enter Password" & Chr(10) &
"Attempt " & i, Title:=MyTitle2, Type:=2)

If Passwrd = False Then Exit Sub

'check password value in Col B
If FoundCell.Offset(0, 1).Value = CStr(Passwrd) Then

'get file name & path from Col C
MyFile = FoundCell.Offset(0, 2).Value

On Error GoTo myerror
Set OpenWB = Workbooks.Open(MyFile, Password:=Passwrd)

'do stuff here

Else

msg = MsgBox("Password Not Valid", vbInformation, MyTitle)

i = i + 1

If i > 3 Then

Exit Sub

Else

GoTo enterpassword

End If

End If

Else

msg = MsgBox("Value " & Search & " Not Found", vbInformation, MyTitle)

GoTo startsearch

End If

myerror:
If Err > 0 Then

MsgBox (Error(Err))
Err.Clear

End If

End Sub

 

[Mike H]

Hi,

I tested this with 5000 users and it worked fine so we have to suspect it's
your data.

To test the data, using an ID that doesn't work, write the search variable
to your USERS worksheet and do a Boolean test to check if it is the same as
the User ID on the sheet. With the search variable in (say) D1 try the formula

=D1=A999 and it should return TRUE if they are the same

where A999 is what you think is the match. A very common reason this type of
test fails is numbers as text with rogue spaces on the worksheet. If this
fails and if you are able to, upload your file to the link below and post the
link, someone will help.

http://www.savefile.com/

Mike

 

[john]

Hi,
Sorry I did not see your following up post on this matter my antivirus keeps
blocking email responses from this site.

Mike has very kindly performed a robust test & offered some practical steps
you can take to test your data.

Only suggestion I can make is with the settings for Find.
When I quickly posted the code I omitted some settings which may be
contributing to your problem if users have set their desktop settings
differently when using Find.

I have modified code to accommodate this & it may or may not help you but
worth a go.

Sub FindStaff()
Dim FoundCell As Range
Dim ws1 As Worksheet
Dim Search As Variant
Dim Passwrd As Variant
Dim MyFile As String
Dim MyTitle As String
Dim OpenWB As Workbook

Set ws1 = Worksheets("Users") '<< change as required

MyTitle = "Open My WorkBook"

startsearch:
Search = Application.InputBox(prompt:="User ID", _
Title:=MyTitle, Type:=2)


If Search = False Then Exit Sub

'search for staff number
Set FoundCell = ws1.Columns("A").Find _
(Search, LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If FoundCell Is Nothing = False Then

i = 1
enterpassword:
Passwrd = Application.InputBox(prompt:="Enter Password" & Chr(10) & _
"Attempt " & i, _
Title:=MyTitle2, _
Type:=2)

If Passwrd = False Then Exit Sub

'check password value in Col B
If FoundCell.Offset(0, 1).Value = CStr(Passwrd) Then

'get file name & path from Col C
MyFile = FoundCell.Offset(0, 2).Value

On Error GoTo myerror
Set OpenWB = Workbooks.Open(MyFile, Password:=Passwrd)

'do stuff here

Else

msg = MsgBox("Password Not Valid", vbInformation, MyTitle)

i = i + 1

If i > 3 Then

Exit Sub

Else

GoTo enterpassword

End If

End If

Else

msg = MsgBox("Value " & Search & " Not Found", vbInformation, MyTitle)

GoTo startsearch

End If

myerror:
If Err > 0 Then

MsgBox (Error(Err))
Err.Clear

End If

End Sub