How can I edit a protected cell to enter a value manually and thenprotect it again (automatically)

[SNM]

I need some help with protected cells. I have many cells with
formulas. All of them are protected. However, sometimes I cannot
accept the value calculated by the formula and in such cases, I need
to enter the value manually. To do this, I want to edit the cell by
using a password. Different users will be entering the value manually
so if possible I would like to have a recording system of the user
name. Also after the value is entered, the cell should be protected
again. Is this too ambitious? I would really appreciate a prompt
response on this matter. Thanking in advance.

 

[Bernie Deitrick]

SNM,

Insert a new worksheet into your workbook, and name it Record Sheet. In Cell A1 enter "Date and
Time", in B1 enter "User Name", and in C1 enter "Manually entered Value".

Copy the code below, right-click the sheet tab with the cell that you want to be able to edit,
select "View Code" and paste the code into the window that appears. Change the address to the cell
that you want to overwrite - in the code it is currently C4, set with the code line

Set ECell = Range("C4")

As written, this will only work with one cell, but can be modified to include many cells, if
desired.

Make sure that all the cells are locked, the sheet is password protected, and.... give it a try.
The record sheet will include the date/time, the username, and the value entered into the cell.

HTH,
Bernie
MS Excel MVP

Option Explicit
Public myPW As String
Public GoodPW As Boolean
Public ECell As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myR As Long
If GoodPW And Target.Address = ECell.Address Then
Target.Parent.Unprotect myPW
ECell.Locked = True
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 = ECell.Value
End With
Target.Parent.Protect myPW
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set ECell = Range("C4")
If Target.Address <> ECell.Address Then Exit Sub
If MsgBox("Do you want to edit cell " & ECell.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
ECell.Locked = False
Target.Parent.Protect myPW

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

End Sub

 

[SNM]

Hi,

Thanks so much for your help. I tried it out but two lines of the
code appear in red and show some compilation error. As a result it
wasn't working. Can you please check this.
__________
If MsgBox("Do you want to edit cell" & ECell.Address(False, False) &
"?", vbYesNo) = vbNo Then Exit
Sub
____________

Thanks
SNM

 

[Gord Dibben]

That is all one line which got line-wrapped in the posting.

Add a continuation character as so........note the <space> between ) _

If MsgBox("Do you want to edit cell" & ECell.Address(False, False) _
& "?", vbYesNo) = vbNo Then Exit Sub


Gord Dibben MS Excel MVP

 

[SNM]

That is all one line which got line-wrapped in the posting.

Add a continuation character as so........note the <space> between ) _

If MsgBox("Do you want to edit cell" & ECell.Address(False, False) _
& "?", vbYesNo) = vbNo Then Exit Sub

Gord Dibben MS Excel MVP

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

 

[Bernie Deitrick]

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

 

[SNM]

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

Done. Thanks so much. It worked like magic!

SNM

 

[Bernie Deitrick]

Done. Thanks so much. It worked like magic!

It is magic! I'm glad to hear that you like it.

Bernie