need to freez column on each monday if it has previous dates
- Thread starter Sadhana
- Start date
shrivallabha
Excel Ninja
Hi Sadhana,
Your request is not clear (at least) to me.
Please explain the layout you have and the kind of data. Which columns are to be checked for freezing or all columns.
If you feel describing is difficult, try uploading a sample.
Your request is not clear (at least) to me.
Please explain the layout you have and the kind of data. Which columns are to be checked for freezing or all columns.
If you feel describing is difficult, try uploading a sample.
Hi shrivallabha,
I have a sheet with dates as colum heads. Each day is a column. Now I want to lock the columns which has previous date. for example if I open the sheet today yesterday's column should be locked for editing.
I hope it is clear now.. if not please let me know.
Thanks you,
Sadhana
I have a sheet with dates as colum heads. Each day is a column. Now I want to lock the columns which has previous date. for example if I open the sheet today yesterday's column should be locked for editing.
I hope it is clear now.. if not please let me know.
Thanks you,
Sadhana
sgmpatnaik
Active Member
@Sadhana
Hi
Please check this code while i use this
Option Explicit
Private Sub Workbook_Open()
Const PW As String = "secret"
Dim rBookings As Range
Dim cl As Range
Dim mArea As Range
With Sheets("Shet1")
.Unprotect PW
'if no cells have entries in the range the code will error
'the exit handler skips to the point where the password is reset
On Error GoTo exithandler
Set rBookings = .Range(.Cells(7, 4), .Cells(20000, 10)).SpecialCells(xlCellTypeConstants)
MsgBox rBookings.Address
For Each cl In rBookings
Set mArea = .Cells(cl.Row, 1).MergeArea
If mArea.Cells(1, 1).Value < Date Then cl.Locked = True
Next cl
exithandler:
.Protect PW
End With
End Sub
Note: This code will work when the Column B is Merged then it will start lock from the Column D and it starts from Row 7
Hope it will help full
Thanks
SP
Hi
Please check this code while i use this
Option Explicit
Private Sub Workbook_Open()
Const PW As String = "secret"
Dim rBookings As Range
Dim cl As Range
Dim mArea As Range
With Sheets("Shet1")
.Unprotect PW
'if no cells have entries in the range the code will error
'the exit handler skips to the point where the password is reset
On Error GoTo exithandler
Set rBookings = .Range(.Cells(7, 4), .Cells(20000, 10)).SpecialCells(xlCellTypeConstants)
MsgBox rBookings.Address
For Each cl In rBookings
Set mArea = .Cells(cl.Row, 1).MergeArea
If mArea.Cells(1, 1).Value < Date Then cl.Locked = True
Next cl
exithandler:
.Protect PW
End With
End Sub
Note: This code will work when the Column B is Merged then it will start lock from the Column D and it starts from Row 7
Hope it will help full
Thanks
SP