Use VBA to lock formula cells

eliz

New Member
Joined
Sep 12, 2006
Messages
46
Hi, this is my first time here... I think you guys are great!

I require code that will (after saving the file and again before closing the file) loop through all worksheets in the workbook, lock any cells that contain formulas (if they are not already locked) and protect all worksheets.

The idea is to reset the entire file to be protected so the user doesn't forget to manually lock/protect before closing in case a different user is opening the file and doesn't know how to protect, etc.. Also by having it re-protect when saves are done, it doesn't leave the spreadsheets as vulnerable, because the user will have to manually unprotect the sheet(s) to make a formula change.

Just wondering how protection/locking etc. affects a user inserting rows that change the range referred to in some of the formulas?

Thanks,
Eliz
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi, eliz,

WELCOME to the BOARD !!!!!

try this
Code:
Sub lock_formulas()
'Erik Van Geit
'060914

Dim SH As Worksheet
Dim rng As Range

On Error Resume Next

    For Each SH In Worksheets
    SH.Unprotect
    
        With SH.UsedRange
        .Locked = False
        Set rng = Nothing
        Set rng = .SpecialCells(xlCellTypeFormulas)
        If Not rng Is Nothing Then rng.Locked = True
        End With
        
    SH.Protect
    Next SH

End Sub
kind regards,
Erik
 

eliz

New Member
Joined
Sep 12, 2006
Messages
46
Thank you very much Erik, it worked like a charm...

Another question. When the sheet is protected, it greys out the insert row/column commands.
What if a user needs to insert a row of additional data. If there a way to alter the code to allow them to do this also?

Thx,
Eliz
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Eliz,

This depends on the version of Excel you are running...
Do you have an optionlist when protecting a sheet? Then check it.

The easiest way to get the syntax you need, is to record a macro. Menu Tools/Macro: record macro.
Then you do anything you need (in this case protect the sheet and check the options.
think about to stop the recording
Code:
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingColumns:=True, AllowInsertingRows:=True
you can understand, it's almost plain english ;)

greetings from Belgium,
Erik
possibly without internet-connection within 2 hours till 22th sept

PS:
coincidence ? Just read about Elisa this morning in "Kings" part of the Bible
 

eliz

New Member
Joined
Sep 12, 2006
Messages
46

ADVERTISEMENT

Thanks Erik! I will give that code a try...
Have a great day!
Eliz
 

eliz

New Member
Joined
Sep 12, 2006
Messages
46
VBA to change colour of formula cells if locked or unlocked

is it possible, in addition to the code above to have all formula cells appear in one color if the sheet is protected, but to appear in another color when the user unprotects the sheet. Keeping in mind that the code autoprotects each sheet upon opening/saving.

Just curious...

Thx.

BTW, your
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
this can be done
take a look at Interior & ColorIndex in the helpfiles

Code:
If Not rng Is Nothing Then
rng.Locked = True 
rng.Interior.ColorIndex = 6
End

but what it the purpose ?
is it to be sure the user will not change formulas without knowing ?
then try this
Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Erik Van Geit
'060915
'warning when locked cells are changed
'code can slow down when large used range and changing large range

Dim cell As Range
Dim msg As String
Dim rng As Range
Dim i As Integer

If Intersect(Target, UsedRange).Cells.Count > Rows.Count Then Exit Sub

    For Each cell In Target
        If cell.Locked Then
        'msg = msg & vbTab & cell.Address(0, 0)
            If rng Is Nothing Then
            Set rng = cell
            Else
            Set rng = Union(rng, cell)
            End If
        End If
    Next cell

    If Not rng Is Nothing Then
    
        With rng
        .Select
            For i = 1 To .Areas.Count
            msg = msg & vbLf & .Areas(i).Address(0, 0)
            Next i
        End With
        
        If MsgBox("Changed:" & msg, 36, "Do you really want to change these locked cells?") = vbNo Then
            With Application
            .EnableEvents = False
            .Undo
            .EnableEvents = True
            End With
        ElseIf Target.Count > 1 Then Target.Select
        End If

    End If

End Sub
greetings from Belgium,
Erik

EDIT: inserted a codeline:
If Intersect(Target, UsedRange).Cells.Count > Rows.Count Then Exit Sub
if large amounts of cells are involved the code will loop to long
 

Forum statistics

Threads
1,136,345
Messages
5,675,219
Members
419,553
Latest member
hanahass

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
Top