Hi,
I'm new to this and I've managed to copy a few different codes from this forum to suit my needs. Unfortunately I have one issue I just can't to find or sort out.
In my code, if the operator inputs the wrong password a message box appears saying "Incorrect Password" and when the operator selects OK, the code asks to save the file.
I would like the message box to have a retry option, and when retry is selected, the code starts again and doesn't ask to save the file.
I hope this all makes sense.
Any help will be much appreciated.
Thanks
Dan
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim pwd As String
Dim Oops As Boolean
Const DB As String = "77"
Const AL As String = "zoro"
Const MG As String = "password"
Const AxS As String = "mu"
Const MT As String = "bc"
Const RT As String = "85"
Const PD As String = "65"
Const GC As String = "1611"
Const GD As String = "fred"
Const RW As String = "7899"
Const RH As String = "852"
Const MK As String = "798"
Const PP As String = "157"
Const MN As String = "6182"
Const KA As String = "2384"
Application.EnableEvents = False
For Each cell In Target
If Not Intersect(cell, Range("G:G")) Is Nothing And cell <> "" Then
pwd = Application.InputBox("Password for " & cell & ":", _
"Enter Password", Type:=2)
Select Case cell.Value
Case "DB"
If pwd <> DB Then Oops = True
Case "AL"
If pwd <> AL Then Oops = True
Case "MG"
If pwd <> MG Then Oops = True
Case "AS"
If pwd <> AxS Then Oops = True
Case "MT"
If pwd <> MT Then Oops = True
Case "RT"
If pwd <> RT Then Oops = True
Case "PD"
If pwd <> PD Then Oops = True
Case "GC"
If pwd <> GC Then Oops = True
Case "GD"
If pwd <> GD Then Oops = True
Case "RW"
If pwd <> RW Then Oops = True
Case "RH"
If pwd <> RH Then Oops = True
Case "MK"
If pwd <> MK Then Oops = True
Case "PP"
If pwd <> PP Then Oops = True
Case "MN"
If pwd <> MN Then Oops = True
Case "KA"
If pwd <> KA Then Oops = True
End Select
If Oops Then
MsgBox "Incorrect Password", vbCritical, "Palletiser Operator"
cell = ""
End If
End If
Next cell
Application.EnableEvents = True
Dim rng As Range
' Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
Set rng = Target.Parent.Range("G:G")
' Only look at single cell changes
If Target.Count > 1 Then Exit Sub
' Only look at that range
If Intersect(Target, rng) Is Nothing Then Exit Sub
' Action if Condition(s) are met (do your thing here)
Response = MsgBox("Are you happy with the P/O change?" & vbCrLf & "" & vbCrLf & "If you select Yes then this P/O will be locked!", vbQuestion + vbYesNo, " Palletiser Operators")
If Response = vbNo Then
Exit Sub
End If
ActiveCell.Offset(0, -6).Select
ActiveSheet.Protect "motorola"
ActiveSheet.Unprotect "motorola"
Target.EntireRow.Locked = True
ActiveSheet.Protect "motorola"
ChDir "C:\Palletiser"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="Palletiser Changeover Form.xlsm"
Application.DisplayAlerts = True
End Sub
Bookmarks