Locking a cell after you click it?

**Aus_Dex** · 12-08-2011, 10:20 PM

Hi,

I am using the following formula below, to enter the current date in excel once you click a cell within the range. Is it possible, once you click the cell and the date is entered automatically to lock the cell with a password so it can not be edited?
Formula is as follows: (thanks to TOM1977)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myrange As Range
Set myrange = Union(Range("A1:A10"), Range("C1:C10"))
If Not Intersect(Target, myrange) Is Nothing Then
Target = Format(Now, "dd/mm/yyyy")
End If
End Sub

Thanks

**Mordred** · 12-08-2011, 11:46 PM

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here

**Aus_Dex** · 12-08-2011, 11:56 PM

Hi,

Sorry Mordred.... New Here.

I am using the following formula below, to enter the current date in excel once you click a cell within the range. Is it possible, once you click the cell and the date is entered automatically to lock the cell with a password so it can not be edited?
Formula is as follows: (thanks to TOM1977)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myrange As Range
Set myrange = Union(Range("A1:A10"), Range("C1:C10"))
If Not Intersect(Target, myrange) Is Nothing Then
Target = Format(Now, "dd/mm/yyyy")
End If
End Sub

Thanks

**wamp** · 12-09-2011, 08:37 AM

How about just putting a validation-rule on it; - making the exact text the only possible option?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myrange As Range
Set myrange = Union(Range("A1:A10"), Range("C1:C10"))
If Not Intersect(Target, myrange) Is Nothing Then
Target = Format(Now, "dd/mm/yyyy")
'altered:
Target.Validation.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Target.Value
End If
End Sub