Auto lock of cell once data entry

[Jitu Marathe]

Hii, Gyus
I am using following codes for current time and current date in sheets,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 And Target.Column <> 5 Then Exit Sub
Application.EnableEvents = False
Target.Offset(0, -1).Value = Date
Target.Offset(0, 1).Value = Now - Date
Range("G5:G60").Formula = "=IF(OR(RC[-1]="""",RC[-4]=""""),"""",RC[-1]-RC[-4])"
Application.EnableEvents = True
End Sub

Now,I want to auto lock and protection to all the cells once data Entry into any cell so what no one can edit the Cells.
Pls suggest what modification is required in above codes.

 

[galvinpaddy]

Good morning,

Do you want to lock the whole sheet or just the cells with data in?

 

[galvinpaddy]

Good morning (again lol)

If you are working from Sheet1, right click the tab, click view code and paste the following:

Dim blnUnlockedAllCells As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const RangeToLock As String = "A2:D1000" '<<  adjust to suit
    
    If Target.Cells.Count > 1 Then Exit Sub
    
    If Not blnUnlockedAllCells Then
        Me.Cells.Locked = False
        On Error Resume Next
        Me.Range(CStr(RangeToLock)).SpecialCells(2).Locked = True
        On Error GoTo 0
        blnUnlockedAllCells = True
        Me.Protect Password:="pwd", userinterfaceonly:=True
    End If
    
    If Not Application.Intersect(Target, Me.Range(CStr(RangeToLock))) Is Nothing Then
        If Len(Target) Then Target.Locked = True
    End If
    
End Sub

To adjust the area that will be locked - change the A2:D10000

    Const RangeToLock As String = "A2:D1000" '<<  adjust to suit

to whatever range you are after.

 

[Jitu Marathe]

do i need to paste this codes below the code which are already there for current time and current date as mentioned in 1st post , if i do the same then its shows the compile error.
pls suggest.

 

[Jitu Marathe]

gr8 its working now i have paste as,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 And Target.Column <> 5 Then Exit Sub
Application.EnableEvents = False
Target.Offset(0, -1).Value = Date
Target.Offset(0, 1).Value = Now - Date
Range("G5:G60").Formula = "=IF(OR(RC[-1]="""",RC[-4]=""""),"""",RC[-1]-RC[-4])"
Application.EnableEvents = True
Dim blnUnlockedAllCells As Boolean

Const RangeToLock As String = "A2:K1000" '<< adjust to suit

If Target.Cells.Count > 1 Then Exit Sub

If Not blnUnlockedAllCells Then
Me.Cells.Locked = False
On Error Resume Next
Me.Range(CStr(RangeToLock)).SpecialCells(2).Locked = True
On Error GoTo 0
blnUnlockedAllCells = True
Me.Protect Password:="pwd", userinterfaceonly:=True
End If

If Not Application.Intersect(Target, Me.Range(CStr(RangeToLock))) Is Nothing Then
If Len(Target) Then Target.Locked = True
End If

End Sub

hope i do correct????

 

[galvinpaddy]

Hello,

Can you tell me what range it is that you want to have protected?
When i run your code, i need to type data into Column B, and the formula produces dates in column A and times in column C, do you requrie all of these locking?

 

[Jitu Marathe]

Thanks galvinpaddy,
actually i have connected my Excel sheet with Bar code Scanner so ,
according to my application purpose i need to scan each item two times
so when i do scan 2nd time , my requirement is that it should come in E column and row no. should match the Same item which was scan earlier in B column.
E.g if scan Jitu in B2 then A2 will show current date, c2 will show current time.
after 2nd time scan Jitu should come to E2 only, D2 will show current date , F2 will show current time and G2 will be difference between F2 and C2
pls suggest .