I have a workbook that requires users to enter a username and password in order to open it.
I want to enter the Login name that is entered into cell D7 of Sheet1 (Hide this Sheet).
I am looking for some help in adding a suitable line or bit of code that will do this.
The VBA Code is as follows:
Forms - VBA
Workbook vba
Can anyone please help?
I want to enter the Login name that is entered into cell D7 of Sheet1 (Hide this Sheet).
I am looking for some help in adding a suitable line or bit of code that will do this.
The VBA Code is as follows:
Forms - VBA
Code:
Option Explicit
Dim ws As Worksheet
Dim cl As Range
Dim rng As Range
Dim bOK As Boolean
Dim iCounta As Integer
Dim sPW As String
Dim sLevel As String
Dim sUser As String
Dim sMsg As String
Dim a, b As Integer
Const sTitle As String = "Incorrect Password"
Const sStyle As String = vbOKOnly + vbExclamation
Sub validatePW()
On Error GoTo err_handler
If Me.cboUser.Value = "Manager" And Me.tbxPW = Sheet1.Cells(4, 1).Value Then
Me.cmdManage.Visible = True
Exit Sub
End If
Select Case iCounta
Case 1, 2, 3
With Sheet1
Set rng = .Range(.Cells(8, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set cl = rng.Find(sUser, LookIn:=xlValues)
End With
If cl.Offset(0, 1).Value <> Me.tbxPW.Text Then
sMsg = "You have entered an incorrect Password" _
& vbNewLine & "Try again" & vbNewLine & _
"You have " & iCounta & " goes left"
MsgBox sMsg, sStyle, sTitle
With Me
.cboUser.Value = vbNullString
.tbxPW = vbNullString
.cboUser.SetFocus
Exit Sub
End With
ElseIf cl.Offset(0, 1).Value = Me.tbxPW.Text Then
sLevel = cl.Offset(0, 2).Value
MsgBox "Correct Information Entered. Please Proceed.", vbOKOnly + _
vbInformation, "Correct Information entered."
Sheets("Splash").Visible = xlSheetVisible
bOK = True
If InStr(1, sLevel, ",", vbTextCompare) > 0 Then
a = 1
b = (InStr(1, sLevel, ",", vbTextCompare)) - 1
Do While True
Sheets(Mid(sLevel, a, b)).Visible = xlSheetVisible
If InStr(a + b, sLevel, ",", vbTextCompare) > 0 Then
a = InStr(a, sLevel, ",", vbTextCompare) + 1
b = InStr(a, sLevel, ",", vbTextCompare) - a
Else
Exit Do
End If
Loop
Else
Sheets(sLevel).Visible = xlSheetVisible
End If
Unload Me
End If
Case 0
MsgBox "You have tried three time incorrectly. WorkBook will now close" _
, vbOKOnly + vbExclamation, "Warning"
bOK = True
Unload Me
Exit Sub
err_handler:
'this line should be used in the final version
' ActiveWorkbook.Close SaveChanges:=False 'close without saving
End Select
End Sub
Private Sub cmdManage_Click()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
bOK = True
Unload Me
End Sub
Private Sub cmdValidatePW_Click()
sUser = Me.cboUser.Text
sPW = Me.tbxPW.Text
iCounta = iCounta - 1
validatePW
End Sub
Private Sub UserForm_Initialize()
iCounta = 3
With Sheet1
Me.cboUser.List = .Range(.Cells(8, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
End With
Me.cboUser.SetFocus
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If bOK Then GoTo theend
If CloseMode = 0 Then Cancel = True
MsgBox "Sorry, you must enter your password & username", vbExclamation, "Warning"
theend:
End Sub
Code:
Option Explicit
Option Compare Text
Dim ws As Worksheet
Const MaxUses As Long = 5 '<- change uses
Const wsWarningSheet As String = "Splash"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'hide all sheets except warning sheet
For Each ws In ThisWorkbook.Sheets
If ws.Name = wsWarningSheet Then
ws.Visible = True
Else
ws.Visible = xlVeryHidden
End If
Next
'record opening in remote cell
With Sheets(wsWarningSheet).Cells(Rows.Count, Columns.Count)
.Value = .Value + 1
End With
End Sub
Private Sub Workbook_Open()
frmPW.Show
End Sub
Can anyone please help?