Cell protection only for cells with formulas when saved in a new workbook

Question

I have a workbook which contains sheets with formulas in some of the cells. I want to protect the cells containing these formulas from editing, but I don't want to protect the non-formula containing cells. When I save the worksheet I want the cell protection for the formulas to propagate to the new worksheet.

for example Consider my workbook A containing two sheets (Sheet1 and Sheet2).

Sub protect()
Dim pwd As String

pwd = InputBox("entrer a password", Title:="Password")

Worksheets("Sheet1").Activate
    Worksheets("Sheet1").Copy
    Cells.Select
    Cells.SpecialCells(xlCellTypeFormulas).Locked = True
    Worksheets("Sheet1").Protect pwd, True, True, True, True
    ActiveWorkbook.SaveAs Filename:="myfile1"
    ActiveWorkbook.Close
    ThisWorkbook.Activate

    Worksheets("Sheet2").Activate
    Worksheets("Sheet2").Copy
    Cells.Select
    Cells.SpecialCells(xlCellTypeFormulas).Locked = True
    Worksheets("Sheet2").Protect pwd, True, True, True, True
    ActiveWorkbook.SaveAs Filename:="myfile2"
    ActiveWorkbook.Close
    ThisWorkbook.Activate

 End Sub

When I run this code all the cells (which contains formulas or not) of both "myfile1" and "myfile2" are protected. I only want to protect the cells which contain formulas.

How do I accomplish just protecting only the cells with formulas?

Unknown Unknown · Accepted Answer · 2016-05-08T18:35:54

By default, all cells in a worksheet are locked. You can change them because the worksheet is not protected. You do not need to lock the formulas; you need to unlock the blanks and constants.

Cells.SpecialCells(xlCellTypeBlanks).Locked = False
Cells.SpecialCells(xlCellTypeConstants).Locked = False

Relying on Range .Activate and Worksheet.Activate and naming your sub procedure the same as the primary command that you are running are not good ideas.

Sub myProtect()
    Dim pwd As String, s As Long

    pwd = InputBox("entrer a password", Title:="Password")

    With ThisWorkbook
        For s = 1 To 2
            With .Worksheets("Sheet" & s)
                .Copy
            End With

            With ActiveWorkbook
                With .Worksheets(1)
                    .UsedRange
                    On Error Resume Next    '<~~just in case there are no constants or blanks
                    .Cells.SpecialCells(xlCellTypeBlanks).Locked = False
                    .Cells.SpecialCells(xlCellTypeConstants).Locked = False
                    On Error GoTo 0
                    .protect pwd, True, True, True, True
                End With
                .SaveAs Filename:="myfile" & s, FileFormat:=xlOpenXMLWorkbook
                .Close SaveChanges:=False
            End With
        Next s
    End With

 End Sub

I've looped the actions to reduce redundant code. Depending on your actual naming conventions, you might have to make some changes.

Please note that when unlocking the .Cells, you are only referring to cells within the Worksheet.UsedRange property. This may have to be modified if you want to unlock a larger range of cells.

Cell protection only for cells with formulas when saved in a new workbook

1 Answers