Error on Code
 

Hi,

I am using the code below to stop the wrong users inserting / deleting rows
or columns.

Problem is it works once, but if it is tried twice it fails at the .Undo
point in the code.

Any Ideas?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Msg As String
Dim pWord As String
pWord = "mypassword"
Msg = "Deleting or Inserting Rows/Columns Not Permitted - Contact Workbook
Author for access"
If Target.Address = Target.EntireRow.Address Or _
Target.Address = Target.EntireColumn.Address Then
response = InputBox("Enter password")
If response = pWord Then Exit Sub
With Application
..EnableEvents = False
..Undo
Msg = MsgBox(Msg, 16, "WARNING - PERMISSION REFUSED")
..EnableEvents = True
End With
Else
Exit Sub
End If
End Sub

Craig

Error on Code
 

Worked just fine for me when I started with a new workbook and pasted the
code in. I could try to delete rows and columns at will and your code worked
just fine.

What is the error message you're getting? Is there other code in your
workbook? Are any of the worksheets or the workbook protected?

Eric

P.S. - if you put Option Explicit at the top of the module, you'll be
chastized for not declaring "response"!


"Craig" wrote:

Hi,

I am using the code below to stop the wrong users inserting / deleting rows
or columns.

Problem is it works once, but if it is tried twice it fails at the .Undo
point in the code.

Any Ideas?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Msg As String
Dim pWord As String
pWord = "mypassword"
Msg = "Deleting or Inserting Rows/Columns Not Permitted - Contact Workbook
Author for access"
If Target.Address = Target.EntireRow.Address Or _
Target.Address = Target.EntireColumn.Address Then
response = InputBox("Enter password")
If response = pWord Then Exit Sub
With Application
.EnableEvents = False
.Undo
Msg = MsgBox(Msg, 16, "WARNING - PERMISSION REFUSED")
.EnableEvents = True
End With
Else
Exit Sub
End If
End Sub

Craig