Locking cells once a date has passed

[dave3009]

Hi Everyone

I am having a little dilemma searching for a solution to a problem. I'd like to lock a range of cells once a certain date has passed. I ran a search and found this thread which would be great if I knew the range I wanted to lock.

http://www.mrexcel.com/board2/viewtopic.php?t=185572&highlight=date+lock

However in my case I am looking at ranges that change by month and by individual territory. I have two constant factors I could use date and month (month as I am using SUMIF to summarise the data). Is there any way I could lock a row if the month has passed i.e. if the date/month cell states August but it is now September the row locks

Thanks for any help


Dave

 

[sunnyland]

Hello,

You could try this code. For this purpose, let's say the date are in column 1 or A and the worksheet with data is called sheet1 [codename]

If your date are in another column change a to whatever letter is your column in the line:

Set myrange = Sheet1.Range("a1").Resize(Sheet1.Range("a65535").End(xlUp).Row)

and replace any references to sheet1 with your worksheet name

Private Sub Workbook_Open()
Sheet1.Unprotect ("")
Dim rowi As Range
Dim myrange As Range
Set myrange = Sheet1.Range("a1").Resize(Sheet1.Range("a65535").End(xlUp).Row)
For Each rowi In myrange
If VarType(rowi) = 7 Then
If Year(rowi) < Year(Date) Or (Month(rowi) < Month(Date) And Year(rowi) = Year(Date)) Then
rowi.EntireRow.Cells.Locked = True
Else
rowi.EntireRow.Cells.Locked = False
End If
Else
rowi.EntireRow.Cells.Locked = False
End If
Next
Sheet1.Protect ("")
End Sub