Lock cells after today's date passed (to prevent tempering historical data)

[cyee]

Dear Chandoo,


I have here an excel sheet that has a progressive date from left to right column. A date is assigned to each column on the top. ( e.g.: 1/2/10, 2/2/10) Everyday after the daily data has been entered, I will like to create a marco that reads the date of each column (as assigned earlier) and lock the column which are less than say =today()-2. (incase of weekends). Is this possible? Appreciate if you can show me how can this be achieved. Thanks a bunch!

 

[Hui]

Cyee

Try the following macro


It assumes there is a value in each cell from A1 accross

and the Dates are in the row Defined as DateRow

[pre]

Sub Lock_Columns()

'
'Sub by Hui May 2010
'

Dim cv As Variant
Dim col As Variant
Dim Offset_days As Integer
Dim DateRow As Integer

OffsetDays = 2 'Change this to suit
DateRow = 1 'Dates are in Row 1

Cells.Select 'Select all cells
ActiveSheet.Unprotect 'Unprotect all cells

For Each col In ActiveSheet.Columns
cv = Str(Cells(DateRow, col.Column).Value) 'Get the value of first cell in each column
If cv = "" Or cv = 0 Then Exit For 'if it is undefined exit

If Val(Left(cv, InStr(cv, "/") - 1)) < Val(Left(Now(), InStr(Now(), "/") - 1)) - OffsetDays Then 'If Day No < Now - Offset days
col.Select  'Select Column
Selection.Locked = True  'Set Locked Property
End If
Next

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'Lock all locked Columns

End Sub
The next subroutine is just in case

Its use is self explantory

Sub Unlock_Columns()
Cells.Select
ActiveSheet.Unprotect
Selection.Locked = False
Selection.FormulaHidden = False
End Sub

[/pre]

 

[sjindal]

If changed to the following, will this work for the scenario where the worksheet has the dates in the rows, and we would like to lock the rows after the date passes (no continegency for weekends, hence off-set = 0).


Dim cv As Variant

Dim row As Variant

Dim Offset_days As Integer

Dim DateColumn As Integer


OffsetDays = 0 'Change this to suit

DateColumn = B 'Dates are in Row 1


Cells.Select 'Select all cells

ActiveSheet.Unprotect 'Unprotect all cells


For Each row In ActiveSheet.Rows

cv = Str(Cells(DateColumn, row.Rows).Value) 'Get the value of first cell in each column

If cv = "" Or cv = 0 Then Exit For 'if it is undefined exit


If Val(Left(cv, InStr(cv, "/") - 1)) < Val(Left(Now(), InStr(Now(), "/") - 1)) - OffsetDays Then 'If Day No < Now - Offset days

Row.Select 'Select Column

Selection.Locked = True 'Set Locked Property

End If

Next


ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'Lock all locked Columns


End Sub

 

[SirJB7]

@sjindal

Hi!

If your post weren't related to the original topic you should have started a new topic instead of writing on another user's one. It might be seen as hijacking.

In this case is related, but being such and old post it'd be advisable to create a new one and if needed you could add a reference to the older.

Perhaps you'd want to read the three green sticky posts at this forums main page so as to know the guidelines that will lead to know how this community operates (introducing yourself, posting files, netiquette rules, and so on).

Regards!

 

[sjindal]

Sure, I'll create a new post. Thanks!