Lock Cells Based on Date Value in Another Cell

N

nau2002

Board Regular
Joined
Dec 19, 2016
Messages
97
Hello,

I have some code for a worksheet change event that consists of two macros to prevent changes to a 'closed' period within my spreadsheet and then to prevent users from overwriting formulas. The period was in Cell C1. My code worked when I had my spreadsheet set up where each column represented a month. Example below:

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]N[/TD]
[TD]O[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]Period[/TD]
[TD]Mar-17[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Measurement:[/TD]
[TD]Target[/TD]
[TD]Jan-17[/TD]
[TD]Feb-17[/TD]
[TD]Mar-17[/TD]
[TD]Dec-17[/TD]
[TD]YTD[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Attrition[/TD]
[TD]5-10%[/TD]
[TD]3.9%[/TD]
[TD]5.5%[/TD]
[TD]4.1%[/TD]
[TD][/TD]
[TD]4.5%[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD]Target Min[/TD]
[TD]5%[/TD]
[TD]5%[/TD]
[TD]5%[/TD]
[TD][/TD]
[TD]5%[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD]Target Max[/TD]
[TD]10%[/TD]
[TD]10%[/TD]
[TD]10%[/TD]
[TD][/TD]
[TD]10%[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Utilization[/TD]
[TD]>80%[/TD]
[TD]104%[/TD]
[TD]96%[/TD]
[TD]98%[/TD]
[TD][/TD]
[TD]101%[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD]Target[/TD]
[TD]80%[/TD]
[TD]80%[/TD]
[TD]80%[/TD]
[TD]80%[/TD]
[TD]80%[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Here is my original code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim msg As String
'Macro #1
'check if the row is greater than 1.
If Target.Row > 1 Then
'if the selected column date is less than the B1 date
If Range("C1") > Cells(2, Target.Column) Then
Application.EnableEvents = False
'undo the change
Application.Undo

Application.EnableEvents = True
'throw a messagebox
msg = MsgBox("This column is for a scorecard reporting period that is not open." & vbNewLine & " " & vbNewLine & "Please only enter data for the current reporting period, or contact the Investment Management Team for assistance." & vbNewLine & _
vbNewLine & "" & vbNewLine & "OK to move right to allowed date." & vbNewLine & "Cancel to view current reporting date.", vbOKCancel)
'stop checking for events
Application.EnableEvents = False
Select Case msg
Case 1 'OK button pressed
'loop until the B1 date is less or equal to the header date
Do Until Range("C1") <= Cells(2, ActiveCell.Column)
'shift one cell to the right
ActiveCell.Offset(0, 1).Select
Loop
Case 2 'Cancel Button pressed
'select C1
Range("C1").Select
Case Else
End
End Select
'enable event checking
Application.EnableEvents = True
End If

End If

'Macro #2
'if the selected cell is not equal to range 'Blocked'
If Not Application.Intersect(Target, Range("Blocked")) Is Nothing Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
'throw a messagebox
msg = MsgBox("You can not make changes to the formulas on this spreadsheet." & vbNewLine & vbNewLine & _
vbNewLine & "" & "Please contact the team for assistance.", vbOKCancel)
'stop checking for events
Application.EnableEvents = False
Select Case msg
Case 1 'OK button pressed
'loop until the B1 date is less or equal to the header date


Range("C1").Select

Case 2 'Cancel Button pressed
'take user to the C1
Range("C1").Select
Case Else
End
End Select
'enable event checking
Application.EnableEvents = True
End If
End Sub

I was asked to change this workbook so that it was by quarter (versus monthly). Now the code doesn't appear to fire at all and I'm presuming it's because the quarters aren't being recognized as dates but I don't know if that's really relevant to my code as someone else helped me create the code :). Here's my new code that is no longer firing upon changes to a cell in a 'closed period' (e.g. C3):


Private Sub Worksheet_Change(ByVal Target As Range)
Dim msg As String
'Macro #1
'check if the row is greater than 1.
If Target.Row > 1 Then
'if the selected column date is less than the B1 date
If Range("C102") > Cells(103, Target.Column) Then
If Application.Intersect(Target, Range("Formulas")) Is Nothing Then
Application.EnableEvents = False
'undo the change
Application.Undo

Application.EnableEvents = True
'throw a messagebox
msg = MsgBox("This column is for a scorecard reporting period that is not open." & vbNewLine & " " & vbNewLine & "Please only enter data for the current reporting period, or contact the Investment Management Team for assistance." & vbNewLine & _
vbNewLine & "" & vbNewLine & "OK to move right to allowed date." & vbNewLine & "Cancel to view current reporting date.", vbOKCancel)
'stop checking for events
Application.EnableEvents = False
Select Case msg
Case 1 'OK button pressed
'loop until the B1 date is less or equal to the header date
Do Until Range("C1") <= Cells(2, ActiveCell.Column)
'shift one cell to the right
ActiveCell.Offset(0, 1).Select
Loop
Case 2 'Cancel Button pressed
'select C1
Range("C1").Select
Case Else
End
End Select
'enable event checking
Application.EnableEvents = True
End If

End If
End If

'Macro #2
'if the selected cell is not equal to range 'Blocked'
If Not Application.Intersect(Target, Range("Blocked")) Is Nothing Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
'throw a messagebox
msg = MsgBox("You can not make changes to the formulas on this spreadsheet." & vbNewLine & vbNewLine & _
vbNewLine & "" & "Please contact the Team for assistance.", vbOKCancel)
'stop checking for events
Application.EnableEvents = False
Select Case msg
Case 1 'OK button pressed
'loop until the B1 date is less or equal to the header date


Range("C1").Select

Case 2 'Cancel Button pressed
'take user to the C1
Range("C1").Select
Case Else
End
End Select
'enable event checking
Application.EnableEvents = True
End If
End Sub


And here's how the worksheet looks now:


[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]Period:[/TD]
[TD]2017-Q2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Measurement[/TD]
[TD]Target[/TD]
[TD]2017-Q1[/TD]
[TD]2017-Q2[/TD]
[TD]2017-Q3[/TD]
[TD]2017-Q4[/TD]
[TD]YTD[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Attrition[/TD]
[TD]5-10%[/TD]
[TD]3.9%[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD]Target Min[/TD]
[TD]5%[/TD]
[TD]5%[/TD]
[TD]5%[/TD]
[TD]5%[/TD]
[TD]5%[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD]Target Max[/TD]
[TD]10%[/TD]
[TD]10%[/TD]
[TD]10%[/TD]
[TD]10%[/TD]
[TD]10%[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Utilization[/TD]
[TD]>80%[/TD]
[TD]98%[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD]Target[/TD]
[TD]80%[/TD]
[TD]80%[/TD]
[TD]80%[/TD]
[TD]80%[/TD]
[TD]80%[/TD]
[/TR]
</tbody>[/TABLE]


Anyone know why it would appear my code no longer works?
 
You must log in or register to reply here.

Similar threads

S
  • Solved
Multiple Select Drop in a Single Cell
2
Replies
10
Views
320
scoobydoo
S
D
  • Question Question
Locking of cells after not working
2
Replies
11
Views
294
Dazzatron
D
K
  • Solved
Undo Stack gets cleared running VBA - Possible Solution to fix this?
Replies
5
Views
632
kellman
K
E
  • Question Question
VBA - If Cell IsDate and Another Column is a formula then make Cell a hyperlink
2
Replies
17
Views
432
eli_m
E
E
  • Locked
  • Question Question
VBA - If Cell IsDate and Another Column is a formula then make Cell a hyperlink
Replies
2
Views
199
Fluff
Fluff

Share this page

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
Back
Top