Another approach i to protect all completed cells when closing the workbook, this way the code will not run at every change, slowing down work.
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim LastRow, LastColumn
Dim LastCell As String
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="1234"
With ActiveSheet
If WorksheetFunction.CountA(Cells) > 0 Then
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
If WorksheetFunction.CountA(Cells) > 0 Then
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
LastCell = "A1:" & Split(Columns(LastColumn).Address, "$")(2) & LastRow
.Range(LastCell).Cells.Locked = False
For Each cell In .Range(LastCell).Cells
If Not IsEmpty(cell) Then
cell.Locked = True
End If
Next cell
ActiveSheet.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End With
End Sub