S
salgud
I have this macro in ThisWorkbook:
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
'Activated by a change in any worksheet in the workbook - gets password
from user
' verifies password, and unprotects worksheet
MsgBox "Sheet Change"
Dim vResponse As Variant
Set wsPwrdNames = ThisWorkbook.Sheets("sheet1")
Set rShNames = wsPwrdNames.Range("ShNames")
Set rPwrdEnt = wsPwrdNames.Range("bPwrd")
If rPwrdEnt.Value = "True" Then Exit Sub 'EXIT
Set rFoundShName = rShNames.Find(ActiveSheet.Name, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If rFoundShName Is Nothing Then Exit Sub 'EXIT
wsPwrdNames.Visible = True
PwrdForm:
ufPwrdEntry.Show
If sPwrd = rFoundShName.Offset(0, 1).Value Then
bPwrdEntrd = True
Application.EnableEvents = False
rPwrdEnt.Value = bPwrdEntrd
Application.EnableEvents = True
Else
vResponse = MsgBox("Incorrect Password! Click OK to try again, Cancel
to exit", _
vbOKCancel)
If vResponse = vbCancel Then
ufPwrdEntry.Hide
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
wsPwrdNames.Visible = False
End 'EXIT
Else
GoTo PwrdForm
End If
End If
wsPwrdNames.Visible = False
End 'EXIT
wsPwrdNames.Visible = False
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub 'EXIT
Private Sub Workbook_SheetDeactivate(ByVal ws As Object)
'when active worksheet is deactivated, reset variables and reinstate
passord protection
Application.ScreenUpdating = False
Set wsPwrdNames = ThisWorkbook.Sheets("sheet1")
Set rPwrdEnt = wsPwrdNames.Range("bPwrd")
bPwrdEntrd = False
Application.EnableEvents = False
rPwrdEnt.Value = bPwrdEntrd
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
The MsgBox at the beginning should be popping up every time I make a sheet
change, but it's not showing at all. I've checked in the Immediate Window
to make sure Events are turned on. Any ideas as to what else could cause
this code to be inoperative?
Thanks.
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
'Activated by a change in any worksheet in the workbook - gets password
from user
' verifies password, and unprotects worksheet
MsgBox "Sheet Change"
Dim vResponse As Variant
Set wsPwrdNames = ThisWorkbook.Sheets("sheet1")
Set rShNames = wsPwrdNames.Range("ShNames")
Set rPwrdEnt = wsPwrdNames.Range("bPwrd")
If rPwrdEnt.Value = "True" Then Exit Sub 'EXIT
Set rFoundShName = rShNames.Find(ActiveSheet.Name, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If rFoundShName Is Nothing Then Exit Sub 'EXIT
wsPwrdNames.Visible = True
PwrdForm:
ufPwrdEntry.Show
If sPwrd = rFoundShName.Offset(0, 1).Value Then
bPwrdEntrd = True
Application.EnableEvents = False
rPwrdEnt.Value = bPwrdEntrd
Application.EnableEvents = True
Else
vResponse = MsgBox("Incorrect Password! Click OK to try again, Cancel
to exit", _
vbOKCancel)
If vResponse = vbCancel Then
ufPwrdEntry.Hide
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
wsPwrdNames.Visible = False
End 'EXIT
Else
GoTo PwrdForm
End If
End If
wsPwrdNames.Visible = False
End 'EXIT
wsPwrdNames.Visible = False
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub 'EXIT
Private Sub Workbook_SheetDeactivate(ByVal ws As Object)
'when active worksheet is deactivated, reset variables and reinstate
passord protection
Application.ScreenUpdating = False
Set wsPwrdNames = ThisWorkbook.Sheets("sheet1")
Set rPwrdEnt = wsPwrdNames.Range("bPwrd")
bPwrdEntrd = False
Application.EnableEvents = False
rPwrdEnt.Value = bPwrdEntrd
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
The MsgBox at the beginning should be popping up every time I make a sheet
change, but it's not showing at all. I've checked in the Immediate Window
to make sure Events are turned on. Any ideas as to what else could cause
this code to be inoperative?
Thanks.