Lock cells after date and time specified in adjacent cells

P

pontiff

Board Regular
Joined
Jun 11, 2009
Messages
150
Office Version
  1. 2016
Hi, I want to be able to lock cells f3 and G3 after a date and time specified in c3 (date) and d3(time). Is this possible without vba , or if not could somebody assist with the vba?
Thanks in advance.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
Don't know if there is a non-VBA solution. You can try this VBA if you want. Format columns C and D as text. Paste the code into the "ThisWorkbook" module.
VBA Code: 
Private Sub Workbook_Open()
    Dim dateNow As String
    Dim timeNow As String
    Dim wbPw As String
    
    dateNow = Format(Now, "dd-mm-yyyy") '<------ Change to the format you want here
    timeNow = Format(Now, "hh:mm:ss") '<------ Change to the format you want here
    wbPw = "pw" '<--------- Change the sheet protection password here
    
    If TimeValue(timeNow) > TimeValue([D3]) And DateValue(dateNow) >= DateValue([C3]) Then
        With ThisWorkbook.ActiveSheet
            .Unprotect Password:=wbPw
            .Range("F3:G3").Locked = True
            .Protect Password:=wbPw
        End With
        ThisWorkbook.Save
    End If
End Sub

1720378117781.png
 
Upvote 0
Thanks very much, I will try this! Could this be altered to apply to the next row down and so on ? Really appreciate your help.
 
Upvote 0
Sure, on which rows do you want it to start and end?
 
Upvote 0
Test this out. Made it so you can adjust the rows and columns, and fixed a mistake that made it not lock if the date was due but not the time :P
VBA Code: 
Private Sub Workbook_Open()
    On Error GoTo ErrorHandler:
    Dim dateNow As String
    Dim timeNow As String
    Dim wbPw As String
    
    rStart = 3 '<------- You can change start/end row, columns to lock, and columns for time/date here
    rEnd = 40
    colDate = "C"
    colTime = "D"
    colLock1 = "F"
    colLock2 = "G"
    
    dateNow = Format(Now, "dd-mm-yyyy") '<------ Change to the format you want here
    timeNow = Format(Now, "hh:mm:ss") '<------ Change to the format you want here
    wbPw = "pw" '<--------- Change the sheet protection password here
    
    With ThisWorkbook.ActiveSheet
            .Unprotect Password:=wbPw
            For i = rStart To rEnd
            If Evaluate(colTime & i) = "" Or Evaluate(colDate & i) = "" Then GoTo NextIteration
            If (TimeValue(timeNow) > TimeValue(Evaluate(colTime & i)) And DateValue(dateNow) = DateValue(Evaluate(colDate & i))) Or DateValue(dateNow) > DateValue(Evaluate(colDate & i)) Then
                .Range(colLock1 & i).Locked = True
                .Range(colLock2 & i).Locked = True
                Else
                .Range(colLock1 & i).Locked = False
                .Range(colLock2 & i).Locked = False
            End If
NextIteration:
        Next
        .Protect Password:=wbPw
    End With
    ThisWorkbook.Save
    
    Exit Sub
ErrorHandler:
    MsgBox ("Something went wrong when locking cells based on time and date")
End Sub
 
Upvote 0
That’s great thanks, I’ll give it a try and get back to you!
 
Upvote 0
I noticed an error, dates are tricky but this should be working.... test thoroughly :D Also added a variable for the sheet, in case you have multiple in your workbook (this will only work on one of them as it is set up now).

VBA Code: 
Private Sub Workbook_Open()
    On Error GoTo ErrorHandler:
    Dim dateNow As String
    Dim timeNow As String
    Dim wbPw As String
    Dim sheetToLock As Worksheet
    
    Set sheetToLock = ThisWorkbook.Worksheets(1) '<------ Change number or sheet name ThisWorkbook.Worksheets("sheet name") to change which worksheet is affected
    rStart = 3 '<------- You can change start/end row, columns to lock, and columns for time/date here
    rEnd = 40
    colDate = "C"
    colTime = "D"
    colLock1 = "F"
    colLock2 = "G"
    
    dateFormat = "dd-mm-yyyy" '<------ Change to the format you want here
    dateNow = Format(Now, dateFormat)
    timeNow = Format(Now, "hh:mm:ss") '<------ Change to the format you want here
    wbPw = "pw" '<--------- Change the sheet protection password here
    
    dayNow = Day(dateNow)
    monthNow = Month(dateNow)
    yearNow = Year(dateNow)
    
    With sheetToLock
            .Unprotect Password:=wbPw
            For i = rStart To rEnd
            If .Range(colTime & i) = "" Or .Range(colDate & i) = "" Then GoTo NextIteration
            dayThen = Day(Format(DateValue(.Range(colDate & i)), dateFormat))
            monthThen = Month(Format(DateValue(.Range(colDate & i)), dateFormat))
            yearThen = Year(Format(DateValue(.Range(colDate & i)), dateFormat))
            
            Dim timeAndDateDue As Boolean
            timeAndDateDue = False
            
            If yearNow < yearThen Then
                timeAndDateDue = False
            ElseIf yearNow > yearThen Then
                timeAndDateDue = True
            Else
                If monthNow < monthThen Then
                    timeAndDateDue = False
                ElseIf monthNow > monthThen Then
                    timeAndDateDue = True
                Else
                    If dayNow < dayThen Then
                        timeAndDateDue = False
                    ElseIf dayNow > dayThen Then
                        timeAndDateDue = True
                    Else
                        timeAndDateDue = timeNow > TimeValue(.Range(colTime & i))
                    End If
                End If
            End If
            
            If timeAndDateDue Then
                .Range(colLock1 & i).Locked = True
                .Range(colLock2 & i).Locked = True
                Else
                .Range(colLock1 & i).Locked = False
                .Range(colLock2 & i).Locked = False
            End If
NextIteration:
        Next
        .Protect Password:=wbPw
    End With
    ThisWorkbook.Save
    
    Exit Sub
ErrorHandler:
    MsgBox ("Something went wrong when locking cells based on time and date")
End Sub
 
Upvote 0
Solution
Engberg said:
I noticed an error, dates are tricky but this should be working.... test thoroughly :D Also added a variable for the sheet, in case you have multiple in your workbook (this will only work on one of them as it is set up now).

VBA Code: 
Private Sub Workbook_Open()
    On Error GoTo ErrorHandler:
    Dim dateNow As String
    Dim timeNow As String
    Dim wbPw As String
    Dim sheetToLock As Worksheet
   
    Set sheetToLock = ThisWorkbook.Worksheets(1) '<------ Change number or sheet name ThisWorkbook.Worksheets("sheet name") to change which worksheet is affected
    rStart = 3 '<------- You can change start/end row, columns to lock, and columns for time/date here
    rEnd = 40
    colDate = "C"
    colTime = "D"
    colLock1 = "F"
    colLock2 = "G"
   
    dateFormat = "dd-mm-yyyy" '<------ Change to the format you want here
    dateNow = Format(Now, dateFormat)
    timeNow = Format(Now, "hh:mm:ss") '<------ Change to the format you want here
    wbPw = "pw" '<--------- Change the sheet protection password here
   
    dayNow = Day(dateNow)
    monthNow = Month(dateNow)
    yearNow = Year(dateNow)
   
    With sheetToLock
            .Unprotect Password:=wbPw
            For i = rStart To rEnd
            If .Range(colTime & i) = "" Or .Range(colDate & i) = "" Then GoTo NextIteration
            dayThen = Day(Format(DateValue(.Range(colDate & i)), dateFormat))
            monthThen = Month(Format(DateValue(.Range(colDate & i)), dateFormat))
            yearThen = Year(Format(DateValue(.Range(colDate & i)), dateFormat))
           
            Dim timeAndDateDue As Boolean
            timeAndDateDue = False
           
            If yearNow < yearThen Then
                timeAndDateDue = False
            ElseIf yearNow > yearThen Then
                timeAndDateDue = True
            Else
                If monthNow < monthThen Then
                    timeAndDateDue = False
                ElseIf monthNow > monthThen Then
                    timeAndDateDue = True
                Else
                    If dayNow < dayThen Then
                        timeAndDateDue = False
                    ElseIf dayNow > dayThen Then
                        timeAndDateDue = True
                    Else
                        timeAndDateDue = timeNow > TimeValue(.Range(colTime & i))
                    End If
                End If
            End If
           
            If timeAndDateDue Then
                .Range(colLock1 & i).Locked = True
                .Range(colLock2 & i).Locked = True
                Else
                .Range(colLock1 & i).Locked = False
                .Range(colLock2 & i).Locked = False
            End If
NextIteration:
        Next
        .Protect Password:=wbPw
    End With
    ThisWorkbook.Save
   
    Exit Sub
ErrorHandler:
    MsgBox ("Something went wrong when locking cells based on time and date")
End Sub
Click to expand...
Thanks for all your help with this!
 
Upvote 0
Engberg said:
I noticed an error, dates are tricky but this should be working.... test thoroughly :D Also added a variable for the sheet, in case you have multiple in your workbook (this will only work on one of them as it is set up now).

VBA Code: 
Private Sub Workbook_Open()
    On Error GoTo ErrorHandler:
    Dim dateNow As String
    Dim timeNow As String
    Dim wbPw As String
    Dim sheetToLock As Worksheet
   
    Set sheetToLock = ThisWorkbook.Worksheets(1) '<------ Change number or sheet name ThisWorkbook.Worksheets("sheet name") to change which worksheet is affected
    rStart = 3 '<------- You can change start/end row, columns to lock, and columns for time/date here
    rEnd = 40
    colDate = "C"
    colTime = "D"
    colLock1 = "F"
    colLock2 = "G"
   
    dateFormat = "dd-mm-yyyy" '<------ Change to the format you want here
    dateNow = Format(Now, dateFormat)
    timeNow = Format(Now, "hh:mm:ss") '<------ Change to the format you want here
    wbPw = "pw" '<--------- Change the sheet protection password here
   
    dayNow = Day(dateNow)
    monthNow = Month(dateNow)
    yearNow = Year(dateNow)
   
    With sheetToLock
            .Unprotect Password:=wbPw
            For i = rStart To rEnd
            If .Range(colTime & i) = "" Or .Range(colDate & i) = "" Then GoTo NextIteration
            dayThen = Day(Format(DateValue(.Range(colDate & i)), dateFormat))
            monthThen = Month(Format(DateValue(.Range(colDate & i)), dateFormat))
            yearThen = Year(Format(DateValue(.Range(colDate & i)), dateFormat))
           
            Dim timeAndDateDue As Boolean
            timeAndDateDue = False
           
            If yearNow < yearThen Then
                timeAndDateDue = False
            ElseIf yearNow > yearThen Then
                timeAndDateDue = True
            Else
                If monthNow < monthThen Then
                    timeAndDateDue = False
                ElseIf monthNow > monthThen Then
                    timeAndDateDue = True
                Else
                    If dayNow < dayThen Then
                        timeAndDateDue = False
                    ElseIf dayNow > dayThen Then
                        timeAndDateDue = True
                    Else
                        timeAndDateDue = timeNow > TimeValue(.Range(colTime & i))
                    End If
                End If
            End If
           
            If timeAndDateDue Then
                .Range(colLock1 & i).Locked = True
                .Range(colLock2 & i).Locked = True
                Else
                .Range(colLock1 & i).Locked = False
                .Range(colLock2 & i).Locked = False
            End If
NextIteration:
        Next
        .Protect Password:=wbPw
    End With
    ThisWorkbook.Save
   
    Exit Sub
ErrorHandler:
    MsgBox ("Something went wrong when locking cells based on time and date")
End Sub
Click to expand...
Just had a friend testing this and he says it locks on opening but leaving it open allows you to edit previous rows f and g.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Locking cells / rows after a specific date. VBA?
Replies
9
Views
486
myall_blues
myall_blues
J
  • Question
After Data Entry Lock Cells and Save Data with 2 Options
Replies
0
Views
138
Jboy64
J
K
  • Question
Time and date stamp with drop down menu
Replies
0
Views
327
kmsprague
K
B
  • Question
Locking Sheet after Particular Date
2
Replies
11
Views
396
sijpie
sijpie
G
  • Question
Using a set date to prevent access to Excell tabs and macros
Replies
1
Views
103
Micron
M

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,399
Latest member
alchavar

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top