Locking a row of cells after the last value in the row is entered

[XrayLemi]

Hello all,
I am once again at your mercy. I will apologize up front that I cannot use XL2BB because it is blocked at work. I will have to cut and paste as needed. A person here helped me with my original problem and the solution was fantastic. I'm hoping to find help again as I am WAY out of my league. Image "XL shot 2" is a look at my sheet.
The code in image "XL shot 4" was written under the worksheet to prevent people from cheating. It prevents entering data in cells in column H until data in Column G is entered. If the user then deletes the data in column G the cell in column H is deleted. The code in the workbook section (image XL shot 3) automatically locks the sheets in the workbook when the file is saved and closed. Everything works wonderful!

I now need to add some additional protection. once data is entered in columns B-K I need that corresponding row locked. I also need to give users a warning when the last cell "K" is entered. When the person answers yes, cells B-K in that row are locked. If they answer no, they can edit data in that row until they finally answer yes.
I have tried to copy, paste then manipulate code from different places (Youtube etc.) with limited luck. On separate sheets I can get single cells to lock / warn but not multiple cells at the same time. Also even if I get the additional code to work, I cannot make it work in conjunction with the code that already exists. I would paste the codes I tried but this post would be way longer than it already is.
Thank you in advance
Jim Lemieux

 

[XrayLemi]

So I did as you told me. Now I get a new compile error. It also does something funny with the original code. column H should remain locked until the value in G is entered. Now H remains locked and cannot be used.

 

[Yongle]

Why have you deleted End Sub ?
Please take a bit more care. VBA does not forgive!


Every Sub must finish with End Sub
Every Function must finish with End Function


Place line below immediately above the line beginning Private Function ....

End Sub

 

[XrayLemi]

Sorry Yongle, It's weird. I noticed that when I pasted the code before end sub as you had said, sometimes the program would automatically delete the end sub line. I tried several times and thought I finally got it right. Looks like I still messed it up. Anyway, I added the end sub where you said to now I get a different compile error. I'm learning fast how unforgiving VBA is. Sorry I know I'm driving you nuts.
Jim

 

[Yongle]

The rule is ...
- For each Sub (or Private Sub) ONE End Sub
- For each Function (or Private Function) ONE End Function

(No more pictures) Post your code for me like this (all the code)
Click on <vba/> and paste your code between the code tags

 

[XrayLemi]

Hi again Yongle. I had moved (I think) the codes to where you asked me to. I still get an error as shown in the image I copied. I can enter values in the cells, But I get an error with each entry. Also Even when all the column values are entered column H still remains locked. You had asked in an earlier posting to post my vba code differently. I hope I did this right. Here is the latest
Thank you again
Jim

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, c As Range
  Set r = Range("G6:G5000")
  Set r = Intersect(Target, r)
  If r Is Nothing Then Exit Sub
  
  Application.EnableEvents = False
  
  For Each c In r
    Select Case True
      Case 7 = c.Column 'G
        If c.Value = "" Then
          Cells(c.Row, "H").Value = ""
          Cells(c.Row, "H").Locked = True
          Else
          Cells(c.Row, "H").Locked = False
        End If
      Case Else
    End Select
  Next c
  
  Application.EnableEvents = True

 If Not Intersect(Target.Cells(1, 1), Range("B6").Resize(Rows.Count - 6, Columns.Count - 1)) Is Nothing Then
        If Not IsLocked(Cells(Target.Row, "B").Resize(, 10)) Then
            If Cells(Target.Row, "K") <> "" Then
                If MsgBox("YES to Lock Row " & Target.Row, vbYesNo, "") = vbYes Then Cells(Target.Row, "B").Resize(, 10).Locked = True
            End If
        End If
    End If
Private Function IsLocked(xRng As Range) As Boolean
    Dim Cel As Range
    IsLocked = True
    For Each Cel In xRng
        If Not Cel.Locked Then
            IsLocked = False
            Exit For
        End If
    Next Cel
End Function
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Row > 6 And Target.Column = 2 Then
        Cancel = True
        Target.Offset(-1).Copy: Target.PasteSpecial (xlPasteValuesAndNumberFormats)
        Application.CutCopyMode = False
    End If
End Sub

 

[XrayLemi]

Hi Yongle,
I know you haven't replied to my last post but that's ok. I have bigger problems and I need to change things before I can work on this. some of the changes will directly affect this.
Thanks for the help,
Jim Lemieux

 

[Yongle]

Thanks for letting me know - I will not look at this further
With the changes that you plan, I suggest that if you need some further help then begin a new thread to avoid any confusion