Edit this macro so it locks cells as well as unlocks?

[tonywatsonhelp]

Hi Everyone,

I have a sheet that is set up like a form,

I need people to fill the areas in one row at a time so I have a macro that locks the sheet which I run at the start.

then I have this macro that unlocks the rows in need as the correct data is added.

This all works great except if someone deletes it does not relock the cells heres the code I'll explain how it works after

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Intersect(Range("F15:F101"), Target)
    If xRg Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="august"
    Cells(Target.Row, Target.Column + 1).Resize(1, 7).Locked = False
    Cells(Target.Row + 1, Target.Column).Resize(1, 1).Locked = False
    ActiveSheet.Protect Password:="august"

End Sub

So when you first open the sheet all cells except F15 are locked.
Column F are dropdown boxes and Columns G to L should unlock when F is filled in.
this works great, but hears my problem

lets say someone has filled in 4 rows so rows 15,16,17,18 are fully unlocked and 19 is Just F unlocked.
if you clear F18, the area does not relock itself. and that's what I need.

any ideas how I can do this?

Thanks

Tony

 

[dmt32]

hi,
untested & may need some reworking but see if this update to your code goes in right direction for what you want

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    
    On Error GoTo exitsub
    Set xRg = Me.Range("F15:F101")
    
    If Intersect(Target, xRg) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    Me.Unprotect Password:="august"
    xRg.Cells(1, 1).Locked = False
    With Target
        .Offset(, 1).Resize(1, 7).Locked = Len(Target.Value) = 0
        With .Offset(1, 0)
            With .Resize(xRg.Rows.Count - (Target.Row - 14), 8)
                .Locked = True
                .ClearContents
            End With
            .Locked = Len(Target.Value) = 0
        End With
    End With
exitsub:
    Application.EnableEvents = True
    Me.EnableSelection = xlUnlockedCells
    Me.Protect Password:="august"
End Sub

Dave

 

[tonywatsonhelp]

Hi Dave,
Thanks you, i'll give it a try looks right to me but I can tweek if need be.
Thanks for your help

Tony