Results 1 to 3 of 3

Thread: Lock rows with dates 30 days in the future

  1. #1
    Junior Member
    Join Date
    Apr 2024
    Posts
    1
    Rep Power
    0

    Lock rows with dates 30 days in the future

    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.

    Code:
    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

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,422
    Rep Power
    10
    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
    

    Open the uploaded workbook, and you should end up seeing something like this
    https://i.postimg.cc/BbmKWBCQ/Run-Ma...d-see-this.jpg
    Run Macro and you should see this.JPG




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

    Alan
    Attached Files Attached Files
    Last edited by DocAElstein; 04-24-2024 at 01:23 PM.

  3. #3
    Member p45cal's Avatar
    Join Date
    Oct 2013
    Posts
    94
    Rep Power
    12
    Code:
    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
    Last edited by p45cal; 04-25-2024 at 01:40 PM.

Similar Threads

  1. Insert Missing Dates By Comparing Two Lists Of Dates
    By mahmoud-lee in forum Excel Help
    Replies: 24
    Last Post: 10-16-2013, 04:48 PM
  2. How to Extracting dates and days between 2 dates.
    By Rajesh Kr Joshi in forum Excel Help
    Replies: 9
    Last Post: 08-11-2012, 09:11 PM
  3. Excel Datedif - Days of February
    By Excelfun in forum Excel Help
    Replies: 6
    Last Post: 06-10-2012, 02:32 PM
  4. The Number of Years, Months and Days Between Two Dates
    By Rick Rothstein in forum Rick Rothstein's Corner
    Replies: 7
    Last Post: 06-08-2012, 10:35 PM
  5. Number of Days In A Month
    By Excel Fox in forum Excel and VBA Tips and Tricks
    Replies: 0
    Last Post: 05-14-2011, 08:00 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •