Lock cells on the basis of date VBA

[S M C]

    Dim wksTarget           As Worksheet
    Dim rngDate             As Range
    Dim rngData             As Range
    Dim c                   As Long
    Dim LastRow             As Long
    Dim LastCol             As Long
    Dim blnUnlockedAllCells As Boolean
    
    Const Pwd               As String = "pwd" '<<  adjust to suit
    
    Set wksTarget = ThisWorkbook.Worksheets("Sheet2") '<<  adjust to suit
    
    If Not blnUnlockedAllCells Then
        wksTarget.Protect Password:=Pwd, userinterfaceonly:=True
        wksTarget.Cells.Locked = False
        blnUnlockedAllCells = True
    End If
    
    Set rngData = wksTarget.Range("B3:L16") '<<  adjust to suit. range including the date row
    
    For c = 1 To rngData.Rows.Count
        If CDate(rngData(c, 1)) <= Date - 2 Then
            On Error Resume Next
            rngData.Rows(c).SpecialCells(2).Locked = True
            On Error GoTo 0
        End If
    Next

[Rajesh Kr Joshi]

Thank a lot this is working awesome.Need one more help or rather I should have ask this question in the earlier post- Currently this code is locking only those cells which have data in it (or written something), is it possible to lock all the cell in the given range.

Thnaks
Rajesh

[S M C]

Just remove

.Specialcells(2)

[Admin]

Hi Rajesh,

Since your post counts exceed more than 10, you are now able to download the Classic 2003 Excel Menu from here

[Rajesh Kr Joshi]

Hi ,
Experts, Your solution is working fine, I need one more help from you. Attached is the file in which I wants to implement the macro, but I stuck at a point wherein apart from the green cells, by default all the other cells should be locked, because the green cells are the date base cell lock range. But with the current code only those cells are locked which are with the date range and all other cells are unlocked. It will be great If you can add a tweak in the existing code to fulfil the above requirement. And this macro should start automatically with the sheet open. My miss i should have given all the requirement one go ..thanks for all your assistance.

Thanks
Rajesh

[Admin]

Hi,

You mean like this

Option Explicit
Dim blnUnlockedAllCells As Boolean
Private Sub Workbook_Open()
    
    Dim wksTarget           As Worksheet
    Dim rngDate             As Range
    Dim rngData             As Range
    Dim c                   As Long
    Dim LastRow             As Long
    Dim LastCol             As Long
    Dim blnUnlockedAllCells As Boolean
    
    Const Pwd               As String = "pwd" '<<  adjust to suit
    
    Set wksTarget = ThisWorkbook.Worksheets("Sheet1") '<<  adjust to suit
    
    If Not blnUnlockedAllCells Then
        wksTarget.Protect Password:=Pwd, userinterfaceonly:=True
        wksTarget.Cells.Locked = False
        blnUnlockedAllCells = True
    End If
    
    Set rngData = wksTarget.Range("$C$6:$Y$381") '<<  adjust to suit. range including the date Column
    
    For c = 1 To rngData.Rows.Count
        If CDate(rngData(c, 1)) <= Date - 2 Then
            On Error Resume Next
            rngData.Rows(c).Locked = True
            On Error GoTo 0
        End If
    Next
    
End Sub

Paste this code in 'ThisWorkbook' module.

[Rajesh Kr Joshi]

Hi, It is working same as the same previous code. The date base cells are getting locked, but all the other cells are still unlocked. To make is easy to understand , i have color coded the cells in the attached sheet. I wants all the gray cells to be locked by default when the sheet opens and the green cells will be locked on date basis.

Thanks
Rajesh

[Admin]

Hi Rajesh,

Try this one.

Option Explicit
Dim blnUnlockedAllCells As Boolean
Private Sub Workbook_Open()
    
    Dim wksTarget           As Worksheet
    Dim rngDate             As Range
    Dim rngData             As Range
    Dim c                   As Long
    Dim LastRow             As Long
    Dim LastCol             As Long
    Dim blnUnlockedAllCells As Boolean
    
    Const Pwd               As String = "pwd" '<<  adjust to suit
    
    Set wksTarget = ThisWorkbook.Worksheets("Sheet1") '<<  adjust to suit
    Set rngData = wksTarget.Range("$C$6:$Y$381") '<<  adjust to suit. range including the date Column
    
    If Not blnUnlockedAllCells Then
        wksTarget.Cells.Locked = True
        rngData.Locked = False
        wksTarget.Protect Password:=Pwd, userinterfaceonly:=True
        blnUnlockedAllCells = True
    End If
    
    For c = 1 To rngData.Rows.Count
        If CDate(rngData(c, 1)) <= Date - 2 Then
            On Error Resume Next
            rngData.Rows(c).Locked = True
            On Error GoTo 0
        End If
    Next
    
End Sub

[Rajesh Kr Joshi]

Hi, This works great....Thanks a ton for all your help.

[Admin]

Hi Rajesh,

You are welcome