Locking a row once a value is entered into a cell

[newtoexel79]

Hello all,

With a lot of help from this forum I was able to get my button working correctly on my sheet however I am hoping to add one addition that I hope someone can help with.

We currently have a spreadsheet which we use to track all incoming material. The first 7 columns are unlocked and used to enter the data about the material. The 8th column I now have set that it is locked until the button
"AI Approval" is clicked and the password entered. Once the password is entered then our third party inspector can sign off on the materials. What I am trying to do is once the inspector puts their initials and date into the AI Approval column and save, then the rest of that row is locked and cannot be changed. So if you look at the top row of the example, columns A thru G would be unlocked as long as column H (AI Approval) is not filled out. Once column H is filled out then columns A thru G (row 1) would then be locked and you could not alter anything in them. The purpose is to ensure that once our third party inspector verifies the material, no one can go back in and change it.
Thank you in advance!!

 

[Legacy 143009]

Hi!

Maybe something like this?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns("H")) Is Nothing Then
    Application.EnableEvents = False
    If Target <> "" Then
      Target.Offset(, -7).Resize(1, 8).Locked = True
      ActiveSheet.Protect Password:="Enter your Password"
    End If
    Application.EnableEvents = True
  End If
End Sub

 

[newtoexel79]

Sorry, I should have added my current code to see what I have going on...

 

[Legacy 143009]

But you are unlocking column I. I thought it was H.

 

[newtoexel79]

H is actually a hidden column, so I used H instead of I rather than try to explain.

 

[Legacy 143009]

Then paste this code into Pipe-Tube sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns("I")) Is Nothing Then
    Application.EnableEvents = False
    If Target <> "" Then
      ActiveSheet.Unprotect Password:="HSB1866"
      Target.Offset(, -8).Resize(1, 9).Locked = True
      ActiveSheet.Protect Password:="HSB1866"
    End If
    Application.EnableEvents = True
  End If
End Sub

It will lock the related row automatically right after the value is entered to column I cell.

 

[newtoexel79]

Thank you for the quick reply.... It's not working however

 

[Legacy 143009]

Ok, maybe someone may come up with a better solution

 

[arturojab]

I'm not a great VB programmer but I know programming and logic. Its not the greatest code but it will work for you. The comments tell you what each line does so you can modify it to your needs.

Private Sub worksheet_change(ByVal Target As Range)
    ActiveSheet.Unprotect   Password = "sPw"                                 ' unprotect the sheet so lastcell command will work. You DO have a password to protect your sheet, don't you?
    ActiveCell.SpecialCells(xlLastCell).Select                                     ' find the last cell so you can do all rows of the page. Remove if not needed
    LastRow = ActiveCell.Row                                                           ' get the row number.   Remove if not needed
    Range("A1").Select                                                                      ' return to top of form.   Remove if you did not get the last row number
    ApprovalCol = 12                                                                        ' Column "L" as a number, can be passed as a global variable  You can also pass the StartRow number
    For StartRow = 1 To LastRow                                                      ' begin loop through all rows.   I used Cell(Row,Col) but Range(Col,Row)  could work just as well
                                                                                                        ' if you are checking a single row and you know the row number you do not need a loop routine
        If Cells(StartRow, ApprovalCol) <> "" Then                             ' if approval column is not empty
            With Sheets("Sheet1")                                                         ' change this sheet name to your sheet name
                .Rows(StartRow).Locked = True                                       ' lock the sheet row
            End With
        Else                                                                                          ' this should happen only when your user hits the AI Approval and enters the correct password
                                                                                                        ' so you can probably delete this with statement and just use one side of the IF
            With Sheets("Sheet1")                                                       
                .Rows(StartRow).Locked = False                                      ' unlock the sheet row
            End With
                                                                                                        '  you could ask for the authority for this row by going to the label protsheet.
                                                                                                         ' this exits the loop and stops the routine at each row that does not have authorization
        End If
    Next StartRow                                                                              ' next row if you plan to process the entire page
protsheet:                                                                                         ' Label used to exit for...next loop
   ActiveSheet.Protect Password = "sPw", DrawingObjects:=True, _
             Contents:=True, Scenarios:=True                                         ' protect the sheet.  make sure the password is the same as at the top of the routine. this could be on 1 line
   ActiveSheet.EnableSelection = xlUnlockedCells                            ' allow editing of unlocked cells.
End Sub

Good Luck.

 

[arturojab]

I thought I had it formatted for VB. But when I posted it the formatting disappeared. I'm not sure how to keep the formatting without posting it as a picture.