Help - Need to Lock all cells in range if Column Header <> Today

[jdub12280]

Hello,
Im back for a slightly different twist on my last undertaking. You guys helped me tremendously before, so thought i'd lean on you once more. Long and short, I have a worksheet "DataSheet" that has an input range (c1:ag46). each cell in the first row of this range has a date (march 1 thru march 31). I am trying to use the attached code to Lock cells of any column in the above range, if the date at the top of the column is < or > than the current date. I had planned on using this in either a workbook open event, or after a custom login event. Stepping through, i am able to see that i have set the range correctly, and i am getting it to step column by column, however the column headers (.cells(1,1)) of each column which are to be compared with Date aren't being evaluated 1 at a time. When i used the msg box to show me what was being evaluated, column headers are stepping +2 instead of +1. For the life of me, i can't figure out why.

My goal is to have all cells in range c1:c46 locked if c1 < or > today (03/17). Then repeat for each column... thru AG.


Any assistance or suggestions are greatly appreciated... Please help me get back on track....

Justin


Private Sub test()
Const PW As String = "secretpw"
Dim mRange As Range
Dim cl As Range
Dim mArea As Range
Dim i As Variant
i = 1
Do Until i = 30
With Sheets("DataSheet")
.Unprotect PW

On Error GoTo exithandler
Set mRange = .Range(.Cells(1, 3), .Cells(46, 33)) '"c1", "ag46")
MsgBox mRange.Address '<--test to see if right range is set
For Each cl In mRange
' For i = 1 To 30 Step 1
Set mArea = mRange.Range(.Cells(1, i), .Cells(46, i))
'Set mArea = .Range(.Cells(1, i), .Cells(46, i)) '.MergeArea
'<<<<test to see if comparing to right date, and locking corresponding column>>>>
MsgBox "Range to lock - " & mArea.Address & "date to compare - " & mArea.Cells(1, i).Value 'Cells(1, i).Value
If mArea.Cells(1, i).Value < Date Then cl.Locked = True
i = i + 1
Next cl
exithandler:
.Protect PW
End With


End Sub

[SamT]

Private Sub test()
Const PW As String = "secretpw"
Dim i As Long
With Sheets("DataSheet")
.Unprotect PW

On Error Goto exithandler
.Range(.Cells(1, 3), .Cells(46, 33)).Locked = True
For i = 3 To 33 Step 1
If .Cells(1, i).Value = Date Then Range(.Cells(1, i), .Cells(46, i)).Locked = False
Next i
exithandler:
.Protect PW
End With


End Sub

[jdub12280]

Thanks SAM T,

The right cells are being locked which was my intent. :) I thought of highlighting the column to indicate to the user where entry is allowed.

I tried the following code, and it highlights the same range that is unlocked, however, it also highlights any cells that were selected prior to the code running. Often a single cell, I also selected a whole range, and ran... the column and the whole range was highlighted. Any thoughts to highlight only the intended range regardless of where the last active cell was?

If .Cells(1, i).Value = Date Then Range(.Cells(3, i), .Cells(46, i)).Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Thanks again,

Justin

[mdmackillop]

Try to avoid Selection. Better to assign a range to a variable and work with that

Dim Rng As Range
If .Cells(1, i).Value = Date Then Set Rng = Range(.Cells(3, i), .Cells(46, i))

With Rng.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With