ExcelBanter - Can this be done better?

Hi Dan,

Just to let you know l have completed the coding along the lines in my
original posting and whilst l have still to complete exhaustive
testing everything appears to be working as required.

I will probably apply a workbook level password as well to stop users
changing the workbook structure, sheet names & sheet colours.

In case you are interested this is the code & assumptions:

1) The cells in each of the sheets in the workbook are locked /
unlocked as required
2) Workbook_Open event protects all sheets (ie Call ProtectShts)
3) Workbook_open event launches logon form
4) Logon form has 3 objects, textbox for password, login button,
cancel button
5) Button on 'Start Here' sheet allows user(s) to change logon whist
workbook is open.
6) Input sheets are specific colour
7) Sheet names are consistent format
8) Logon password determines which input sheets are set to either
xlNoRestrictions or xlNoSelection
9) User can have 3 attempts at logging on.

Form Code: (beware line wrapping & commenting)
__________________________________________
Private Sub cbCancel_Click()
Unload frmLogon
ThisWorkbook.Close SaveChanges = False
End Sub
___________________________________________
Private Sub cbLogin_Click()

Static LogCount As Integer
Dim ShtKey As String
Dim myWB As String
Dim DEV As String
Dim Admin As String
Dim CSD As String
Dim HMCI As String
Dim FD As String
Dim CHI As String
Dim LS As String
Dim EDU As String
Dim MyPwd As String

'Set the login tries
LogCount = LogCount + 1
'Set the passwords
DEV = "EE9855"
Admin = "ADMpwd"
CSD = "CSDpwd"
HMCI = "HMCIpwd"
FD = "FDpwd"
CHI = "CHIpwd"
LS = "LSpwd"
EDU = "EDUpwd"
'Assign password entered
MyPwd = tbPwd.Value
'Check it is valid
If _
MyPwd = DEV Or _
MyPwd = Admin Or _
MyPwd = CSD Or _
MyPwd = HMCI Or _
MyPwd = FD Or _
MyPwd = CHI Or _
MyPwd = LS Or _
MyPwd = EDU _
Then
'If valid do this
'........inform user of setup status
Application.StatusBar = "Please wait........setting up
workbook for your login profile."
'........set sheets to be made available
Select Case MyPwd
Case DEV
Call UnprotectShts
ShtKey = ""
Case Admin
Call UnprotectShts
ShtKey = ""
Case CSD
ShtKey = "CSD*"
Case HMCI
ShtKey = "HMCI*"
Case FD
ShtKey = "FD*"
Case CHI
ShtKey = "CHI*"
Case LS
ShtKey = "L&S*"
Case EDU
ShtKey = "EDU*"
End Select
'.......make sheets available / not available
If ShtKey < "" Then
myWB = ThisWorkbook.Name
'.......if logon changed while workbook opened
' with DEV & Admin ensure shts protected
Call ProtectShts
'.............................................
Application.ScreenUpdating = False
For Each Sht1 In Workbooks(myWB).Worksheets
If Sht1.Tab.ColorIndex = 37 Then
If Sht1.Name Like ShtKey Or Sht1.Name Like
"Report*" Then
Sht1.EnableSelection = xlNoRestrictions
Else
Sht1.EnableSelection = xlNoSelection
End If
Sht1.Activate
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Sht1.Range("A1").Select
End If
Next Sht1
End If
'.......tidy up & exit
Sheets("Start Here").Select
LogCount = 0
Unload frmLogon
Application.StatusBar = False
Else
'IF invalid do this
'.......close workbook if user has entered 3 wrong logons
If LogCount = 3 Then
MsgBox ("Invalid Password, the workbook will now close")
LogCount = 0
ThisWorkbook.Close SaveChanges = False
Unload frmLogon
Else
'.......inform user of wrong logon
MsgBox ("Invalid Password, you have " & 3 - LogCount & "
tries left.")
tbPwd.Value = ""
tbPwd.SetFocus
End If
End If

End Sub
__________________________________________________ ______________
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As
Integer)
'Stop user using 'X' button thus obtaining
'previous users permissions.
If CloseMode = vbFormControlMenu Then
MsgBox "You must use the 'Login' or 'Cancel' buttons."
Cancel = True
End If

End Sub
__________________________________________________ ______________

If you have got this far l would be interested in your comments

Regards

Michael.