Lock cells in each column after entered date has passed

RLY

New Member
Joined
May 25, 2010
Messages
44
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

row1Col CCol DCol E
row27/1/198/1/199/1/19
row31.00
row42.00
row52.00
row64.00
row72.50
row87.00
row97.00
row101.50
row112.50
row123.00

<tbody>
</tbody>

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
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,519
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Try:
Code:
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
 
Last edited:

RLY

New Member
Joined
May 25, 2010
Messages
44
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

MrExcel MVP
Joined
May 26, 2009
Messages
17,519
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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.
Rich (BB code):
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

New Member
Joined
May 25, 2010
Messages
44

ADVERTISEMENT

Working great, thanks again for all the help.
 

RLY

New Member
Joined
May 25, 2010
Messages
44

ADVERTISEMENT

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

MrExcel MVP
Joined
May 26, 2009
Messages
17,519
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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

New Member
Joined
May 25, 2010
Messages
44
again - thank you! And I think we're finally done w/ this one :)
 

Forum statistics

Threads
1,141,286
Messages
5,705,517
Members
421,399
Latest member
hjweiss00

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top