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

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,461
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,461
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,461
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,136,317
Messages
5,675,049
Members
419,546
Latest member
RobWayCot

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