Lock rows with dates 30 days in the future

[ChrisJ87]

Hi,

I am trying to create a desk booking tool which only allows bookings to be made using a defined list up to 30 days in the future. I have the below code, pieced together using other codes, as I am not an expert on VBA, but I cannot seem to get it to work as I would like.

I am unable to upload anything from the machine I am using so having to improvise a little

Essentially, I would like to unlock rows within the range E19:AA448 up until a date 30 days in the future (this date can be input into cell A18 using =TODAY()+30). For example, the sheet starts on 6/5/24, if it was that date, I would like to allow only rows within the defined range to be selected as long as the dates within the range A19:A448 doesn't exceed 30 days after the date of 6/5/24, which will be a rolling date based on the current date each time it is opened. Within this example, this would open up rows until 5/6/24.


Option Explicit
Dim blnUnlockedAllCells As Boolean
Private Sub Workbook_Open()

Dim wksTarget As Worksheet
Dim rngDate As Range
Dim rngData As Range
Dim r As Long
Dim LastRow As Long
Dim LastCol As Long
Dim blnUnlockedAllCells As Boolean

Const Pwd As String = "pwd"

Set wksTarget = ThisWorkbook.Worksheets("Vertical")
Set rngData = wksTarget.Range("$A$19:$AA$448")

If Not blnUnlockedAllCells Then
wksTarget.Unprotect Password:=Pwd
wksTarget.Cells.Locked = True
rngData.Locked = False
wksTarget.Protect Password:=Pwd, userinterfaceonly:=True
blnUnlockedAllCells = True
End If

For r = 19 To 448
If CDate(rngData(r, 1)) <= Date + 30 Then
On Error Resume Next
rngData.Rows(r).Locked = True
On Error GoTo 0
End If
Next

End Sub

[DocAElstein]

Hello ChrisJ87
Welcome to ExcelFox :)

I have no experience with coding to lock things. Maybe someone else may help you later with that.

What I can do is a coding to "do something" for 30 days in the future. You may then be able to figure out yourself how to modify the coding to do the unprotecting/ unlock thing

What I give you will effectively make the rows for 30 days in the future visible, ( or specifically have a sensible height ). All the other rows will be so thin they can’t be seen. (Modify the coding to make them a height of zero, and they will be effectively invisible)

I don’t know if this is any use and I also do not know your knowledge level of Excel VBA, so, for now, I will walk you just briefly through my code and sample file.

The sample file has just the dates in

Brief Coding walk through
Rem 0
The usual dimensioning stuff and setting up of ranges

' 0a
Doing anything involving dates in Excel can be a real pain in the arse, especially when sharing a file, since there are different conventions and often Excel gets in a muddle swapping days for months and messing up other formatting etc. I am hoping what I do here will mean that you and me see the same date format. ( I am on German Excel and normally I don’t see the / normally, but I do using that NumberFormat thing. That might not be necessary for you, but hopefully it will do no harm, and help you to share the same file to other people, assuming you want them to see the date format as you do )

Rem 1
Get the current day date, hopefully in the right format

Rem 2
This would normally set the height of the entire data range initially. You may want to mess with that initially so that you can see all the rows depending on what else you have in your actual file, then when the file is ready to pass on, change that to a small number or zero

Rem 3
Because dates have a habit of getting the format we see to be different, it makes manipulating them or trying to find them difficult. In a coding like this that can often be the most difficult part.
Fortunately, one thing can help. You may know that fundamentally, deep down in Excel’s innards, it holds a date as a simple number starting at 1 for some day a very long time ago, and increasing by 1 every day. So I make an array of those simple numbers from the dates in your data range column A.
In VBA it’s much easier to work with that number, rather than some formatted form that might change and fuck everything up

Rem 4
I get the simple Excel number for the current date + 30 days

Rem 5
I find the position along of that simple number for the current date + 30 days, in other words I find where it is in the array of all the simple numbers, and then I adjust that position number a bit to give me the row where the corresponding date is in the worksheet

Rem 6
I give the rows up to the current date + 30 days a sensible height. The rest will be at what you decided to use in Rem 2


Here the coding

Option Explicit
Private Sub Workbook_Open() ' https://www.excelfox.com/forum/showthread.php/2959-Lock-rows-with-dates-30-days-in-the-future
Rem 0
Dim wksTarget As Worksheet, rngData As Range
Set wksTarget = ThisWorkbook.Worksheets("Vertical")
wksTarget.Rows.Hidden = False ' This seems to need to be done if you had chosen previously .RowHeight = 0
Dim Lr As Long
Let Lr = wksTarget.Range("A" & wksTarget.Rows.Count & "").End(xlUp).Row ' Should be 448 unless you add dates
'Set rngData = wksTarget.Range("$A$19:$AA$448")
Set rngData = wksTarget.Range("$A$19:$AA$" & Lr & "")
' 0a date Column 1
Dim rngDts As Range
Set rngDts = rngData.Resize(, 1)
Let rngDts.NumberFormat = "dd\/mm\/yyyy" ' Just to be sure that the dates look like we want to see them
Rem 1
Let wksTarget.Range("A18") = "=TODAY()+30"
Let wksTarget.Range("A18").NumberFormat = "dd\/mm\/yyyy" ' Just to be sure that the dates look like we want to see them
Rem 2 Edit to suit
Let rngData.RowHeight = 15
Let rngData.RowHeight = 5
Rem 3 An array of the dates column in Excel day number
Dim arrDts() As Variant
Let arrDts() = rngDts.Value2
Rem 4
Dim DayTodayPlus30 As Long
Let DayTodayPlus30 = Now() + 30
Rem 5
Dim RwPlus30 As Long
Let RwPlus30 = Application.Match(DayTodayPlus30, arrDts(), 0) + 18 - 1
Rem 6
Let wksTarget.Range("A19:A" & RwPlus30 & "").RowHeight = 15
End Sub



Open the uploaded workbook, and you should end up seeing something like this
https://i.postimg.cc/BbmKWBCQ/Run-Macro-and-you-should-see-this.jpg
5817 https://i.postimg.cc/BbmKWBCQ/Run-Macro-and-you-should-see-this.jpg (https://postimages.org/)




See if that helps. I will happily explain anything in more detail if you want

Alan

[p45cal]

TodayPlus30 = Date + 30
Pwd = "pwd"
With ThisWorkbook.Worksheets("Vertical")
.Unprotect Password:=Pwd
.Cells.Locked = False
For Each cll In .Range("$A$19:$A$448").Cells
If cll.Value > TodayPlus30 Then cll.EntireRow.Locked = True 'to allow only rows within the defined range to be selected
Next cll
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=Pwd, userinterfaceonly:=True
End With