Lock cells in each column after entered date has passed

[RLY]

Please help address this issue:

1. All cells in worksheet 'Sheet1' are locked, except for cells C3:E12 (these are for manual entry)
2. Columns C, D & E have different dates displayed in row 2.
3. After this date has passed, rows 3:12 of that column need to be locked (no more entry allowed).
4. All previously locked cells should remain locked as well
5. This code should be enabled when the worksheet is activated or selected

example:
C2 displays 7/01/19. On 7/02/19 cells C3:C12 should be locked to no longer allow edits/entries.
Now the only unlocked cells should be D3:E12
D2 displays 8/01/19. On 8/02/19 cells D3:D12 should be locked to no longer allow edits/entries.
Now the only unlocked cells should be E3:E12
...etc

[TABLE="width: 189"]
<tbody>[TR]
[TD]row1[/TD]
[TD]Col C[/TD]
[TD]Col D[/TD]
[TD]Col E[/TD]
[/TR]
[TR]
[TD]row2[/TD]
[TD]7/1/19[/TD]
[TD]8/1/19[/TD]
[TD]9/1/19[/TD]
[/TR]
[TR]
[TD]row3[/TD]
[TD]1.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]row4[/TD]
[TD]2.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]row5[/TD]
[TD]2.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]row6[/TD]
[TD]4.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]row7[/TD]
[TD]2.50[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]row8[/TD]
[TD]7.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]row9[/TD]
[TD]7.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]row10[/TD]
[TD]1.50[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]row11[/TD]
[TD]2.50[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]row12[/TD]
[TD]3.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Here's my existing code, but it's not enabled when the sheet is selected and it's not looping to the next column, please assist:


Private Sub Worksheet_Activate()

Set Date_Entry_Cell1 = Range("C2")
Set Data_Entry_Range1 = Range("C3:C12")
Set Date_Entry_Cell2 = Range("D2")
Set Data_Entry_Range2 = Range("D3:D12")
Set Date_Entry_Cell3 = Range("E2")
Set Data_Entry_Range3 = Range("E3:E12")


ActiveSheet.Unprotect


If Date_Entry_Cell1 < Date Then
Data_Entry_Range1.Locked = True


Else
Data_Entry_Range1.Locked = False


End If


ActiveSheet.Protect


End Sub

 

[JoeMo]

Try:

Private Sub Worksheet_Activate()
Dim R As Range
Set R = Me.Range("C3:E12")
For i = 1 To R.Rows(1).Offset(-1, 0).Cells.Count
    If R.Offset(-1, 0).Cells(1, i).Value < Date Then
        Range(R.Cells(1, i), R.Cells(R.Rows.Count, i)).Locked = True
    Else
        Range(R.Cells(1, i), R.Cells(R.Rows.Count, i)).Locked = False
    End If
Next i
End Sub

 

[RLY]

So far, so good. Working as expected & much simpler than my original - Thank you!

One more:
If I have 10 sheets in this workbook (all work the same way, one for each employee) is there a way to place the code so it applies to all sheets?
Or, would I replicate the code in each separate sheet?

 

[JoeMo]

So far, so good. Working as expected & much simpler than my original - Thank you!

One more:
If I have 10 sheets in this workbook (all work the same way, one for each employee) is there a way to place the code so it applies to all sheets?
Or, would I replicate the code in each separate sheet?

You are welcome - thanks for the reply.
If every sheet uses the same range for data entry you can put the routine I gave you in a Workbook_SheetActivate event code in Thisworkbook like this.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim R As Range
Set R = Sh.Range("C3:E12")
For i = 1 To R.Rows(1).Offset(-1, 0).Cells.Count
    If R.Offset(-1, 0).Cells(1, i).Value < Date Then
        Range(R.Cells(1, i), R.Cells(R.Rows.Count, i)).Locked = True
    Else
        Range(R.Cells(1, i), R.Cells(R.Rows.Count, i)).Locked = False
    End If
Next i
End Sub

Notice that "Me" from the individual sheet code has been replaced by "Sh" in the workbook-level code. If you do this delete the individual sheet code to avoid conflict.

 

[RLY]

Working great, thanks again for all the help.

 

[JoeMo]

Working great, thanks again for all the help.

You are welcome - thanks for the reply.

 

[RLY]

This code is working great, but after using it for a few days I find it necessary to now exclude a few sheets from the process.
Let's say I wanted all sheets included except for "Main" and "Summary", is it possible to do this?

Thank you.


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim R As Range
Set R = Sh.Range("C3:E12")
For i = 1 To R.Rows(1).Offset(-1, 0).Cells.Count
If R.Offset(-1, 0).Cells(1, i).Value < Date Then
Range(R.Cells(1, i), R.Cells(R.Rows.Count, i)).Locked = True
Else
Range(R.Cells(1, i), R.Cells(R.Rows.Count, i)).Locked = False
End If
Next i
End Sub

 

[JoeMo]

This code is working great, but after using it for a few days I find it necessary to now exclude a few sheets from the process.
Let's say I wanted all sheets included except for "Main" and "Summary", is it possible to do this?

Thank you.


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim R As Range
If Sh.name = "Main" or Sh.Name = "Summary" then Exit Sub
Set R = Sh.Range("C3:E12")
For i = 1 To R.Rows(1).Offset(-1, 0).Cells.Count
If R.Offset(-1, 0).Cells(1, i).Value < Date Then
Range(R.Cells(1, i), R.Cells(R.Rows.Count, i)).Locked = True
Else
Range(R.Cells(1, i), R.Cells(R.Rows.Count, i)).Locked = False
End If
Next i
End Sub

Add the line in bold blue above.

 

[RLY]

again - thank you! And I think we're finally done w/ this one

 

[JoeMo]

again - thank you! And I think we're finally done w/ this one

You are welcome - thanks for the reply.