Trebby
04-18-2015, 03:10 PM
Hi,
Please can you advise?
I'm still very much a novice to VBA coding and would like some help before I lose all my hair for good :)
I'm trying to allow staff to enter text into merge cells, and once the deadline date has passed it will auto lock these cells so editing cannot be done (audit purposes). I want to do this so it works on a month to month, though my code below only allows for Jan 2015.
Below is the code I'm using but I feel all my ranges aren't quite right
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
Const craig As String = "craig" '<< adjust to suit
Set wksTarget = ThisWorkbook.Worksheets("Consents") '<< adjust to suit
If Not blnUnlockedAllCells Then
wksTarget.Protect Password:=craig, userinterfaceonly:=True
wksTarget.Cells.Locked = False
blnUnlockedAllCells = True
End If
Set rngData = wksTarget.Range("C7:M14") '<< adjust to suit. range including the date row
For c = 7 To rngData.Columns.Count
If CDate(rngData(7, c)) <= Date - 2 Then
On Error Resume Next
rngData.Columns(c).SpecialCells(8).Locked = True
On Error GoTo 0
End If
Next
End Sub
I've attached the sheet to give you a better look into what I am trying to do.
Thanks for you help in advance.
Please can you advise?
I'm still very much a novice to VBA coding and would like some help before I lose all my hair for good :)
I'm trying to allow staff to enter text into merge cells, and once the deadline date has passed it will auto lock these cells so editing cannot be done (audit purposes). I want to do this so it works on a month to month, though my code below only allows for Jan 2015.
Below is the code I'm using but I feel all my ranges aren't quite right
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
Const craig As String = "craig" '<< adjust to suit
Set wksTarget = ThisWorkbook.Worksheets("Consents") '<< adjust to suit
If Not blnUnlockedAllCells Then
wksTarget.Protect Password:=craig, userinterfaceonly:=True
wksTarget.Cells.Locked = False
blnUnlockedAllCells = True
End If
Set rngData = wksTarget.Range("C7:M14") '<< adjust to suit. range including the date row
For c = 7 To rngData.Columns.Count
If CDate(rngData(7, c)) <= Date - 2 Then
On Error Resume Next
rngData.Columns(c).SpecialCells(8).Locked = True
On Error GoTo 0
End If
Next
End Sub
I've attached the sheet to give you a better look into what I am trying to do.
Thanks for you help in advance.