Lock rows with dates 30 days in the future

**DocAElstein** · 04-24-2024, 01:48 AM

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

Code:

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