Lock cells if date is current date minus two days

0
votes

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.

2
excelvba
What is a UCase("500") and why is text masquerading as a number? Treating true numbers as numbers is preferential unless the column contains mixed data types. Where are the dates? – user4039065
So you just need to lock every row with "500" in column D except for the last two days? – Raystafarian
UCase("500") is from another macro that i used for the names of people in column B. And yes, i am doing some modifications in the file, save and close. tomorrow some person ads another row and i check if the added row is correct and so one for an year. But the %$#^%# remember that 1 week ago made a mistake and just modifies without letting me know. – wittman
The last 2 days also have 500 in D column but i must keep them open for the @#$@#$ who forget something . – wittman
The dates are in column A - always – wittman

2 Answers

1
votes

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

0
votes

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