Locking cells / rows after a specific date. VBA?

[mr_ordinaryboy]

dear all,

I'm currently stuck with Excel and I hope you guys can help me.
I am looking to lock specific rows (in the screenshot: the forecast quantity) D6-O6, D9-O9, D12-O12, D15-O15, etc (until D24-O24) after a specific date has passed.
This date will be defined in D3-O6.
So the way it should work is as follow:
For Jan: Once the date in D3 has passed, then all cell the forecast quantity in D6, D9, D12, ... , D24 will be locked and no changes can be made again.
For Feb: Once the date in E3 has passed, then all cell the forecast quantity in E6, E9, E12, ... , E24 will be locked and no changes can be made again.
For March - Dec would be the same as above.

Other cells or rows like D7,D8,etc should be still editable.

Can someone help me with this? I think I might need Excel VBA but I'm just a newbie in this area.

Thank you very much in advance for all the help and support.

BR,

 

[myall_blues]

Can you provide a screenshot showing the column and row numbers and sample dates filled in in D3-O6, and some sample data?

Better yet, download XL2BB and provide a sample using that.

 

[mr_ordinaryboy]

Can you provide a screenshot showing the column and row numbers and sample dates filled in in D3-O6, and some sample data?

Better yet, download XL2BB and provide a sample using that.

it should be like this.

as the date in the D3-J3 has passed, these following cells have to locked:
D6, D9, D12, ... , D24
E6, E9, E12, ... , E24
F6, F9, F12, ... , F24
and so on until the column J

could you please help me?

 

[myall_blues]

Try this - copy and paste this macro into the worksheet code module. To do that: right click the tab for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Type something into one of the cells in the range D26:O26. Once done you should find that the cells you needed to be protected now are.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long
    If Intersect(Target, Range("D6:O26")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect
    Cells.Locked = False
    For i = 4 To 15
        If Cells(3, i).Value < Date Then
            For j = 6 To 24 Step 3
                Cells(j, i).Locked = True
            Next j
        End If
    Next i
    ActiveSheet.Protect
End Sub

 

[mr_ordinaryboy]

Try this - copy and paste this macro into the worksheet code module. To do that: right click the tab for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Type something into one of the cells in the range D26:O26. Once done you should find that the cells you needed to be protected now are.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long
    If Intersect(Target, Range("D6:O26")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect
    Cells.Locked = False
    For i = 4 To 15
        If Cells(3, i).Value < Date Then
            For j = 6 To 24 Step 3
                Cells(j, i).Locked = True
            Next j
        End If
    Next i
    ActiveSheet.Protect
End Sub

Thank you so much for the macro and your help. It works as described.

While testing it, I realised 2 things:
1. If I enter something in the cells (e.g. D6) without entering any date in D3-O3 (in this case D3), the macro will lock the whole sheet. Is it possible to keep the concerned cells editable if there is no date is entered in the D3-O3?
2. If changes are made in the date, e.g. for e.g. in D3, the date was changed from 31.12.2023 to 31.12.2025. The concerned cells D6, D9, D12, ... , D24 arent unlock automatically. I had to enter something in other cell and the concerned cells are editable again. Am I doing something wrong here?

Thank you very much once again for your help, support, patience, and guidance. Its really appreciated.

 

[myall_blues]

See below. I think this fixes both problems, but let me know if not.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long
    If Intersect(Target, Range("D6:O26", "D3:O3")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect
    Cells.Locked = False
    For i = 4 To 15
        If Cells(3, i).Value < Date And Cells(3, i).Value <> "" Then
            For j = 6 To 24 Step 3
                Cells(j, i).Locked = True
            Next j
        End If
    Next i
    ActiveSheet.Protect
End Sub

 

[mr_ordinaryboy]

See below. I think this fixes both problems, but let me know if not.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long
    If Intersect(Target, Range("D6:O26", "D3:O3")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect
    Cells.Locked = False
    For i = 4 To 15
        If Cells(3, i).Value < Date And Cells(3, i).Value <> "" Then
            For j = 6 To 24 Step 3
                Cells(j, i).Locked = True
            Next j
        End If
    Next i
    ActiveSheet.Protect
End Sub

It works like a charm.

Thank you so much for your help and support. Much appreciated

 

[myall_blues]

You’re welcome. Thanks for the feedback.