Allowing entry only once

[Guest]

I have the following code which prevents the user to edit the cell A1 more
than once

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Original As Variant
Dim NewVal As Variant
If Target.Count > 1 Then Exit Sub
If Target.Address = "$A$1" Then
NewVal = Target.Value
Application.EnableEvents = False
Application.Undo
Original = Target.Value
If Original = "" Then
Target = NewVal
Else
MsgBox "No change to this cell is allowed"
End If
Application.EnableEvents = True
End If
End Sub

How do I edit this code to make it work for more than A1 i.e. A1:A100
Thanks
Adam

 

[Guest]

Have a look at Intersect in help. You could test if the Target address
intersects with your desired range, then do your tests for a first time edit.

 

[Dave Peterson]

Have you thought of protecting the worksheet (unlock the cells the users can
change).

Then you could have your code check the ranges that can be changed only once.
If a change is made, you unprotect the worksheet, lock that cell and reprotect
the worksheet. And that locked cell can't be changed.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myChangeOnceCells As Range
Dim myCell As Range
Dim pwd As String

pwd = "hi"

Set myChangeOnceCells = Me.Range("A1,A3,A6,D7,C3,B4,B6")

If Intersect(Target.Cells, myChangeOnceCells) Is Nothing Then Exit Sub

Me.Unprotect Password:=pwd
For Each myCell In Intersect(Target.Cells, myChangeOnceCells).Cells
myCell.Locked = True
Next myCell
Me.Protect Password:=pwd

End Sub

Another option may be to use a hidden sheet. With each initial change, write
that value to the hidden sheet (same address). Then always compare before
accepting/rejecting the proposed changes.