Protect and Track

Hi

You guys are always helpful and so I know I've come to the right place. I'm trying to write code that protects and tracks a file, without using the shared workbook function in Excel.

Here's what it does basically:

1. When you open the file there are two command buttons - first one allows you to make changes to only certain parts of the file, while restricts changes to cells with formulas. Second one asks for a password and then allows you to make whatever changes you want, but tracks the changes.

2. When you enter the password correctly, a value is entered into K1 so that Excel knows you are allowed to make changes to cells in that restricted range.

3. When you make a change, the program undoes it, records what the old value was, asks for the new value in an input box, places the new value in the original cell and prints all the information on a tracking sheet

My problem is that when the input box places the new value in the cell, the code keeps looping because its in that range and thinks it has to do the whole undo process again.

I'm attaching sample code, its not complete yet, but here's the jist of it. The second part of the main if statement (track changes part) is what loops around endlessly. Maybe someone can tell me how to allow excel to accept the change. Thanks.

If Sheet1.Cells(1, 11).Value = "" Then
Application.EnableEvents = False
If Not Intersect(Target, Range("LockedRange")) Is Nothing Then
MsgBox "The action you just made to the following address is
restricted and will be undone." & Target.Address
Application.Undo
End If
Else
' Tracks changes made
If Not Intersect(Target, Range("LockedRange")) Is Nothing Then
Choice = MsgBox("Do you want to change this cell?", vbYesNo, "Warning")
If Choice = vbYes Then
Application.Undo
CellLoc = ActiveCell.Address
PreviousVal = ActiveCell.Formula
Reason = InputBox("Please enter reason for change", "Important")
NewVal = InputBox("Please enter new formula/ value here, followed by " = ":", "Note")
ActiveCell.Formula = NewVal
Sheet11.Cells(2, 1).Value = Date
Sheet11.Cells(2, 2).Value = Application.UserName
Sheet11.Cells(2, 3).Value = CellLoc
Sheet11.Cells(2, 4).Value = PreviousVal
Sheet11.Cells(2, 5).Value = NewVal
Sheet11.Cells(2, 6).Value = Reason
Else
Application.Undo
End If
End If
End If