Protect Row after data entry in last column

[ASitka]

Hello!

I have a project I need some help with. I have a table with about 200 rows. Once I have data entered in column “I”, I would like to be able to lock that specific row from changes, but still be able to input data in the other rows. Column I is the last column, essentially, once that row is complete, I wanted it locked from changes, but still be able to entry data in the rows below until that row becomes complete.

Thanks in advance!!

 

[Hany ali]

hello Try This

Dim mRg As Range
Dim mStr As String

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("A1:F200"), Target) Is Nothing Then
    Set mRg = Target.Item(1)
    mStr = mRg.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Intersect(Range("A1:F200"), Target)
    If xRg Is Nothing Then Exit Sub
    Target.Worksheet.Unprotect Password:="123"
    If xRg.Value <> mStr Then xRg.Locked = True
    Target.Worksheet.Protect Password:="123"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("A1:F200"), Target) Is Nothing Then
    Set mRg = Target.Item(1)
     mStr = mRg.Value
End If
End Sub

 

[ASitka]

Hey thanks it worked!

While playing around with this, I thought of something else I’d like to try. Is there anyway to protect cells that have data input after saving?

 

[herofox]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Me.Save
End Sub
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim trg As Range
    Dim rng As Range
    With Worksheets("Sheet1")
        .Unprotect Password:="secret"
        Set trg = Worksheets("Sheet1").Range("A1:S200")
        On Error Resume Next
        Set rng = trg.SpecialCells(xlCellTypeConstants)
        If Not rng Is Nothing Then
            rng.Locked = True
        End If
        Set rng = Nothing
        Set rng = trg.SpecialCells(xlCellTypeFormulas)
        If Not rng Is Nothing Then
            rng.Locked = True
        End If
        .Protect Password:="secret"
    End With
End Sub

or try to Use This One..
Put this macro on the ThisWorkbook :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ActiveSheet.Unprotect Password:="MyPassword"
    For Each cl In ActiveSheet.UsedRange
        If cl <> "" Then cl.Locked = True
    Next cl
    ActiveSheet.Protect Password:="MyPassword"
End Sub

 

[ASitka]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Me.Save
End Sub
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim trg As Range
    Dim rng As Range
    With Worksheets("Sheet1")
        .Unprotect Password:="secret"
        Set trg = Worksheets("Sheet1").Range("A1:S200")
        On Error Resume Next
        Set rng = trg.SpecialCells(xlCellTypeConstants)
        If Not rng Is Nothing Then
            rng.Locked = True
        End If
        Set rng = Nothing
        Set rng = trg.SpecialCells(xlCellTypeFormulas)
        If Not rng Is Nothing Then
            rng.Locked = True
        End If
        .Protect Password:="secret"
    End With
End Sub

or try to Use This One..
Put this macro on the ThisWorkbook :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ActiveSheet.Unprotect Password:="MyPassword"
    For Each cl In ActiveSheet.UsedRange
        If cl <> "" Then cl.Locked = True
    Next cl
    ActiveSheet.Protect Password:="MyPassword"
End Sub

Hey thanks for the response! I tried both of them and nothing seemed to happen. I should be able to just copy and paste them in right?

 

[herofox]

The code works efficiently, as you can see inside the file.. even though this was your duty from the beginning, and we have been very careful about this matter, that participation must have a file that supports it, in order to avoid wasting the professors’ time.
Password : 1234