Lock cells after Today's date passed (VBA excel code)

Well, there will be cells that contain a reservation name before and after today's date. I want to automatically lock all cells from (D7:J7675) prior to today's date (not including today's date) so that no changes can be made unless you have administrative privileges. This is to protect the integrity of the reservation so that when the reserved thing has been used, the user cannot remove their name to illustrate that they did not use it.

I've attached a sample reservation schedule for reference as to what I mean.

Please Advise,

Thank you

using merged cells makes this more complicated. Try this code in the WorkBook_Open event. Note you must first of all unlock all cells in that range - Format -> Cells -> Protection and de-select Locked

Option Explicit

Private Sub Workbook_Open()
    Const PW   As String = "secret"
    Dim rBookings As Range
    Dim cl     As Range
    Dim mArea  As Range
    With Sheets("Availability")
        .Unprotect PW
        Set rBookings = .Range(.Cells(7, 4), .Cells(7675, 10)).SpecialCells(xlCellTypeConstants)
        For Each cl In rBookings
            Set mArea = .Cells(cl.Row, 1).MergeArea
            If mArea.Cells(1, 1).Value <= Date Then cl.Locked = True
        Next cl
        .Protect PW
    End With
End Sub

Copy the code
Select the workbook in which you want to use the code
Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
In the Project Explorer, find your workbook, and open the list of Microsoft Excel Objects
Right-click on the ThisWorkbook object, and choose View Code
Where the cursor is flashing, choose Edit | Paste

Hi,

Thank you for the code though there seems to be a run time error '1004

Option Explicit

Private Sub Workbook_Open()
    Const PW   As String = "secret"
    Dim rBookings As Range
    Dim cl     As Range
    Dim mArea  As Range
    With Sheets("Availability")
        .Unprotect PW
Set rBookings = .Range(.Cells(7, 4), .Cells(7675, 10)).SpecialCells(xlCellTypeConstants)
For Each cl In rBookings
            Set mArea = .Cells(cl.Row, 1).MergeArea
            If mArea.Cells(1, 1).Value <= Date Then cl.Locked = True
        Next cl
        .Protect PW
    End With
End Sub

Thank you for the help. Please advise on this error.

rt1306,

Please read forum rules below.

I've wrapped you're code for you this time

VBA Noob

Great, it works well. Though there's still one issue. Can you set it so that it locks all the dates prior to today's date meaning it DOES NOT lock today's date. That would be greatly appreciated. Also on another note, my apologies on not wrapping the code.

I want to thank royUK for generating the code and modytrane for tweaking it for me.

rt1306

Update: Nvm, I figured out how to make it less than today's date. Thank you all for the help. Problem is resolved