On Feb 6, 7:48 pm, "Bernie Deitrick" <deitbe @ consumer dot org
wrote:
SNM,

The code below will work on all of columns C and E, and will store the old value in column D of
Record Sheet, and the address of the cell in column E.

Note that the two columns to be controlled with the code is set with the line

Set EditRange = Range("C:C,E:E")

If, for example, you want columns F and I, use

Set EditRange = Range("F:F,I:I")

Pay attention to the single set of double quotes: Set EditRange = Range("F:F","I:I") would result
in columns F, G, H, and I being controlled.

HTH,
Bernie
MS Excel MVP

Option Explicit
Public myPW As String
Public GoodPW As Boolean
Public EditRange As Range
Public EnterDir As Variant
Public ChangedMAR As Boolean
Public EditCell As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myR As Long
If Target.Cells.Count 1 Then Exit Sub
If Intersect(Target, EditRange) Is Nothing Then Exit Sub
If GoodPW Then
Target.Parent.Unprotect myPW
With Worksheets("Record Sheet")
myR = .Cells(Rows.Count, 1).End(xlUp)(2).Row
.Cells(myR, 1).Value = Now
.Cells(myR, 2).Value = Application.UserName
.Cells(myR, 3).Value = Target.Value
Application.EnableEvents = False
Application.Undo
.Cells(myR, 4).Value = Target.Value
.Cells(myR, 5).Value = Target.Address
Target.Value = .Cells(myR, 3).Value
Target.Locked = True
If ChangedMAR Then Application.MoveAfterReturn = True
Application.EnableEvents = True
End With
Target.Parent.Protect myPW
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set EditRange = Range("C:C,E:E")
If Not EditCell Is Nothing Then
If Target.Address = EditCell.Address Then Exit Sub
End If
If Target.Cells.Count 1 Then Exit Sub
If Intersect(Target, EditRange) Is Nothing Then Exit Sub
If MsgBox("Do you want to edit cell " & _
Target.Address(False, False) & "?", vbYesNo) _
= vbNo Then Exit Sub
On Error GoTo BadPW
myPW = Application.InputBox("What is the password?")
GoodPW = False
Target.Parent.Unprotect myPW
GoodPW = True
Target.Locked = False
Set EditCell = Target
Target.Parent.Protect myPW
ChangedMAR = False
If Application.MoveAfterReturn Then
Application.MoveAfterReturn = False
ChangedMAR = True
End If

Exit Sub
BadPW:
MsgBox "That password was incorrect...."

End Sub



Thanks so much! It works perfectly. I would like to to know about the
following enhancements. Please let me know how can go about these:

1) How can I set the Ecell range as an entire column. Also can I set
multiple columns as well. I mean can the same function be run on two
separate columns in the same sheet? If yes, please let me know the
change in code.

2) In the records sheet, I am currently recording the manually entered
value. Please advise how can I record the original value as well.

I greatly appreciate your advise on the above matters.

Regards,
SNM

Done. Thanks so much. It worked like magic!

SNM