Lock cells on the basis of date VBA

Code:

---

    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

---

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

Just remove

Code:

---

.Specialcells(2)

---

Hi Rajesh,

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

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

Hi,

You mean like this

Code:

---

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.

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

Hi Rajesh,

Try this one.

Code:

---

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

---

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

Hi Rajesh,

You are welcome :cheers: