Use VBA to lock formula cells

[eliz]

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

 

[erik.van.geit]

Hi, eliz,

WELCOME to the BOARD !!!!!

try this

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]

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]

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

    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]

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

 

[eliz]

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]

this can be done
take a look at Interior & ColorIndex in the helpfiles

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

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