macro to set cell protection by row, based on pre-populated values

[cm]

I got the code below from one of Dave Peterson's posts -- to set cell
protection based on a value input. Works fine.

For the initial pass, however, the values in the spreadsheet (col b) are
already populated and I need to modify the code for a one-time use to set the
protection of column A using the existing values in column B instead of the
macro running when the worksheet is changed. I don't know how to do this. Any
help appreciated.

 

[cm]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

'one cell at a time
If Target.Cells.Count > 1 Then Exit Sub

'only in column B
If Intersect(Target, Me.Range("B:B")) Is Nothing Then Exit Sub

On Error GoTo ErrHandler:

Me.Unprotect
Target.Offset(0, -1).Locked = CBool(Target.Value = 0)
' target.offset(row,column)
' target.value = 0 means false, 1 means true


ErrHandler:
Me.Protect
Application.EnableEvents = True
End Sub

 

[Dave Peterson]

Maybe something like:

Option Explicit
Sub RunOneTime()

Dim myCell As Range
Dim myRng As Range
Dim wks As Worksheet

Set wks = ActiveSheet

With wks
.Unprotect Password:="no password???"

Set myRng = .Range("b1", .Cells(.Rows.Count, "B").End(xlUp))

For Each myCell In myRng.Cells
myCell.Offset(0, -1).Locked = CBool(myCell.Value = 0)
Next myCell

.Protect Password:="no password???"
End With

End Sub

This code would go in a General module--not behind a worksheet.

 

[Gord Dibben]

Option Explicit

Sub test()
Dim rng As Range
Dim ocell As Range
Set rng = Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp))
ActiveSheet.Unprotect
For Each ocell In rng
If ocell.Value <> "" Then
ocell.Offset(0, -1).Locked = True
End If
Next ocell
ActiveSheet.Protect
End Sub


Gord Dibben MS Excel MVP