Loking Cells by Date

  • Thread starter Thread starter Daniel
  • Start date Start date
D

Daniel

I have a chart where information is filled in every day. I would like the
cells to be available only "today." How do I have the cells lock for all
days that have passed, aas well as all of the days in the future?
 
This should work for you! I took the liberty of highlighting the unlocked
cells yellow. This will maximize readilbilty. If you don't want that then
just delete it out of the code.

Note: The sheet has to be protected for the Lock Property of the cells to
be active.

Sub LockDates()

Const wksName As String = "Sheet1"
Dim cell As Range

Sheets(wksName).Unprotect Password:=""
For Each cell In Sheets(wksName).UsedRange
If cell.Value = Date Then
cell.Locked = False
Else
cell.Locked = True
End If
Next cell
Sheets(wksName).Protect Password:=""

End Sub

If this helps please click "Yes" below.
 
Oops! I forgot the hightlight part.

Sub LockDates()

Const wksName As String = "Sheet1"
Dim cell As Range

Sheets(wksName).Unprotect Password:=""
For Each cell In Sheets(wksName).UsedRange
With cell
If .Value = Date Then
.Locked = False
.Interior.Color = 3
Else
.Locked = True
.Interior.Color = xlNone
End If
End With
Next cell
Sheets(wksName).Protect Password:=""

End Sub
 
Ryan, I had put in that code, but I could still not get it to work. I was
wondering if you had a minute to look at my worksheet that the original post
was for?
 
What did not work? Please explain. Did you get an error? If so, indicate
where in the code.
 
I put in that code that you had said, but nothing happened. I don't know if
i just don't remember if I need to change any of the code, but nothing
happened when I put in the code
 
Put this code in your workbook_open event. This code will unlock all cells
with the date on your system and lock all other cells that have an earlier or
later date.

Option Explicit

Private Sub Workbook_Open()

Const wksName As String = "Sheet1"
Dim cell As Range

Sheets(wksName).Unprotect Password:=""
For Each cell In Sheets(wksName).UsedRange
With cell
If .Value = Date Then
.Locked = False
.Interior.Color = 3
Else
.Locked = True
.Interior.Color = xlNone
End If
End With
Next cell
Sheets(wksName).Protect Password:=""

End Sub
 
Back
Top