Row Protection

[Freshman]

Dear experts,

In a worksheet, from A2 to E200 is the range for users to fill in. Each row
is an application record and users will fill into it. I will approve each
record in column F by a word "approved". After I entered this word and saved
the file, I want that record and above record(s) will be protected by a
password "done" so that no users can edit the details of approved records
anymore except me. Is it require a VBA code? If yes, please advise what is
the code.

Thanks in advance.

 

[Otto Moehrbach]

Yes, it will require VBA. The following macro will do what you want. I
assumed that row 1 contains your headers. This macro must be placed in the
ThisWorkbook module. I assumed that the sheet in question is named
"MySheet". Change this in the code as needed. Note that this macro does
the following in order:
Unprotects the sheet, password "Done".
Unlocks every cell in the sheet.
Locks every cell in every row that contains "Approved" in Column F.
Protects the sheet, password "Done".
I strongly recommend that you use Data Validation in Column F and have
"Approved" as the only allowed selection. This will preclude any
misspellings or typos. HTH Otto
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim i As Range
Application.ScreenUpdating = False
Sheets("MySheet").Select
ActiveSheet.Unprotect Password:="Done"
ActiveSheet.Cells.Locked = False
Range("A1:F200").AutoFilter
Range("A1:F200").AutoFilter Field:=6, Criteria1:="Approved"
On Error GoTo NoApproved
For Each i In Range("A2:F200").SpecialCells(xlCellTypeVisible)
i.EntireRow.Locked = True
Next i
NoApproved:
On Error GoTo 0
Range("A1:F200").AutoFilter
ActiveSheet.Protect Password:="Done"
Application.ScreenUpdating = True
End Sub

 

[mikerickson]

Put this in the code module for the sheet.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim myCell As Range
If Not Application.Intersect(Target, UsedRange) Is Nothing Then
    If Target.EntireRow.Range("f1") = "approved" Then
        Application.EnableEvents = False
            Target.EntireColumn.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
            If Application.InputBox("password required", Type:=2) = "password" Then
                Target.Select
            End If
        Application.EnableEvents = True
    End If
End If
End Sub

 

[Freshman]

Thanks Otto. Best regards.

Yes, it will require VBA. The following macro will do what you want. I
assumed that row 1 contains your headers. This macro must be placed in the
ThisWorkbook module. I assumed that the sheet in question is named
"MySheet". Change this in the code as needed. Note that this macro does
the following in order:
Unprotects the sheet, password "Done".
Unlocks every cell in the sheet.
Locks every cell in every row that contains "Approved" in Column F.
Protects the sheet, password "Done".
I strongly recommend that you use Data Validation in Column F and have
"Approved" as the only allowed selection. This will preclude any
misspellings or typos. HTH Otto
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim i As Range
Application.ScreenUpdating = False
Sheets("MySheet").Select
ActiveSheet.Unprotect Password:="Done"
ActiveSheet.Cells.Locked = False
Range("A1:F200").AutoFilter
Range("A1:F200").AutoFilter Field:=6, Criteria1:="Approved"
On Error GoTo NoApproved
For Each i In Range("A2:F200").SpecialCells(xlCellTypeVisible)
i.EntireRow.Locked = True
Next i
NoApproved:
On Error GoTo 0
Range("A1:F200").AutoFilter
ActiveSheet.Protect Password:="Done"
Application.ScreenUpdating = True
End Sub