CODEWITHSUNDEEP
excelvba
wittman
wittman

Reputation: 305

Lock cells if date is current date minus two days

i have an excel with 500 rows. i have the code that if the cells in column F have the value 500 it will lock the cells. But... if someone tries to modify something today in the last 2 rows ( that are always yesterday and the day before yesterday ) it should be able to do that. So if today is 23.02.2016 he can modify the last 2 rows but not the rest.


 Sub Lock_cells(ByVal Target As Range)
    ActiveSheet.Unprotect
    Dim cl As Range
    If Target.Column = 6 Then
        For Each cl In Target.Cells
            If UCase(cl.Value) = UCase("500") And cl.Column = 6 Then
                Range("a" & cl.Row & ":f" & cl.Row).Locked = True
            Else
                Range("a" & cl.Row & ":f" & cl.Row).Locked = False
            End If
        Next
    End If
    ActiveSheet.Protect
End Sub

Can it work if i put the sub in BeforeClose or on Open and verify if the date condition is true ? Thank you.

Upvotes: 0

Views: 1870

Answers (2)

wittman
wittman

Reputation: 305

for anyone interested i made the code to check if the day is a working day ( a 5 days working week that starts with Monday ) and will keep the last 2 days modifiable (unlocked). The file has 499 rows. So in the first column are the dates, columns 2,3,4,5 have characters and in the column F (column 6) is the value 500 or 0. The macro will check if the value from column F is 500 and if is true will block the row. Furthermore the macro will check if the value with 500 will have a work day as corespondent and if is true it will block the row but if the value 500 is in week-end it will remain modifiable (unlocked). Thank you PankajR for the help. 



Sub Lock_cells()
 Dim rng As Range
 Dim x As Date
  x = Now() - 3
 ActiveSheet.Unprotect "password"
 Dim cl As Range
 Set rng = Range("F3:F499")

    For Each cl In rng.Cells

        If UCase(cl.Value) = UCase("500") And cl.Offset(0, -5).Value < x Then

              If Weekday(cl.Offset(0, -5).Value, vbMonday) < 6 Then

                     Range("a" & cl.Row & ":F" & cl.Row).Locked = True
                    Else
                     Range("a" & cl.Row & ":F" & cl.Row).Locked = False
              End If

        End If

    Next

    ActiveSheet.Protect "password"

End Sub

Upvotes: 0

PankajR
PankajR

Reputation: 407

One way to achieve this is to find the last row and then unlock the last two rows by offset.

Dim LastRow As Range

Set LastRow = Range("F" & Rows.Count).End(xlUp)
Range(LastRow, LastRow.Offset(-1, -5)).Locked = False
Set LastRow = Nothing

EDIT: If you want rows to be unlocked based on dates in column A then you should modify your If condition to compare dates

If UCase(cl.Value) = UCase("500") And cl.offset(0,-5).value < Today() - 2 Then
    Range("a" & cl.Row & ":f" & cl.Row).Locked = True
Else
    Range("a" & cl.Row & ":f" & cl.Row).Locked = False
End If

No need to check for column = 6 since you enter the outer If only if target = 6

Upvotes: 1

Related Questions