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
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
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
Thanks for all your help with this!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
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.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