VBA Lock and Protect cells or range of cells

rluzius

New Member
Joined
Feb 9, 2009
Messages
7
Corporate edict.

I have a worksheet that is locked and protected now, except for cells in a certain collumn. I have named the cells in that column "MS96A".

If a user enters a date in a cell or range of cells anywhere in the column, the changed cells also need to be locked and protected (Once they enter a date, it is not allowed EVER to be changed again. Corporate requirement! *Shrug*).

What I am looking for is this. If the user selects that cell again, they will get the usual pop-up message, "The cell or chart that you are trying to change is protected..."

I think I am close, but I am getting an "End If without block If" error on the If Clause.


Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim MRange As Range
Set MRange = Range("MS96A")
' If Not Intersect(Target, MRange) Is Nothing Then
For Each cell In MRange
Sheets("Sheet1").Unprotect Password:="temp"
cell.Interior.ColorIndex = 3
cell.Font.Color = vbBlack
Selection.Locked = True
Selection.FormulaHidden = False
Next cell
ActiveSheet.Protect Password:="temp", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Should it be?

Code:
Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim MRange As Range
Set MRange = Range("MS96A")
If Not Intersect(Target, MRange) Is Nothing Then
    For Each cell In MRange
        Me.Unprotect Password:="temp"
        cell.Interior.ColorIndex = 3
        cell.Font.Color = vbBlack
        Selection.Locked = True
        Selection.FormulaHidden = False
    Next cell
End If
Me.Protect Password:="temp", DrawingObjects:=False, contents:=True, Scenarios:=False
Me.EnableSelection = xlUnlockedCells
End Sub
 
Upvote 0
I had tried an End If, but it still wouldn't work.

I just needed to remove the underscore at the end of the If statement.

Thanks Greatly
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,192
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top