copy sheet level protection

[ajm]

Folks, i have a management report supported by ten or so individual kpi reports. the kpi reports are all exactly the same as each other except each relates to a different site. all the tab names are the same and all the tabs contain the same structure. each KPI workbook is handled by another person. I have been asked to lock down the KPI reports so that only specific cells can be written to. this is, as you will all know, to stop the user changing anything they are not supposed to. I have gone through the first workbook and locked all the cells that need locking. I am ready to do the sheet level protection now and then on to the next one. its just so tedious. does anyone know how to copy the locked cell format from each tab within this "source" file to each of the other tabs respectively within the other workbooks

 

[gravanoc]

Folks, i have a management report supported by ten or so individual kpi reports. the kpi reports are all exactly the same as each other except each relates to a different site. all the tab names are the same and all the tabs contain the same structure. each KPI workbook is handled by another person. I have been asked to lock down the KPI reports so that only specific cells can be written to. this is, as you will all know, to stop the user changing anything they are not supposed to. I have gone through the first workbook and locked all the cells that need locking. I am ready to do the sheet level protection now and then on to the next one. its just so tedious. does anyone know how to copy the locked cell format from each tab within this "source" file to each of the other tabs respectively within the other workbooks

Sounds like VBA would help here. Absent your workbook, my solution will require editing. Just to be clear though, you're locking certain cells on a sheet and then locking the sheet, and all of this will match identically to the other workbooks?

 

[gravanoc]

This is draft #1 of my solution. It will speed up the process, but I still need to make some changes so that it applies to subsequent workbooks. Please try this out on a workbook. Basically, once I've finished it then it will remember all the sheet names and range addresses, so all you'll need to do is select a workbook to apply further protection.

Sub Protectimus()

    Dim ws() As Worksheet
    Dim rg() As Range
    Dim pw As String
   
    pw = InputBox("Please type password for locking sheets.  If no PW, just hit Enter", "Password Entry")
   
    ReDim ws(1 To Sheets.Count)

    ReDim rg(1 To Sheets.Count)
   
        For i = 1 To Sheets.Count
       
            Set ws(i) = Sheets(Sheets(i).Name)
            ws(i).Activate
            ws(i).Cells.Locked = False
            Set rg(i) = Application.InputBox(prompt:="Select all ranges on " & ws(i).Name & " that require locking, then hit OK.  Hold CTRL to make multiple selections!", _
                                                    Title:="Selection", Type:=8)
            rg(i).Locked = True
            ws(i).Protect Password:=pw, DrawingObjects:=True, Contents:=True, Scenarios:=True
           
        Next
                               
End Sub

 

[Dermot]

What I suggest you do for greater flexibility, is give all unlocked cells a certain colour.

This not only makes it easier for users to see what can be changed, but then the code can go through and lock all the cells except those with the special colour (so you don't need to select them manually).

 

[Dermot]

This code will lock all the sheets, but will leave all the cells coloured yellow (colorindex=6) unlocked

Sub LockSheets()
  Dim r, sht
  For Each sht In Sheets
    Application.StatusBar = "Protecting " & sht.Name
    sht.Unprotect
    sht.UsedRange.Cells.Locked = True
    For Each r In sht.UsedRange
      If r.Interior.ColorIndex = 6 Then r.Locked = False
    Next r
    sht.Protect
  Next sht
  Application.StatusBar = False
End Sub

You will want a different colour. To get its number, colour a cell, then run this code (with the coloured cell selected)

Sub GetColor()
  MsgBox Selection.Interior.ColorIndex
End Sub

 

[ajm]

Sounds like VBA would help here. Absent your workbook, my solution will require editing. Just to be clear though, you're locking certain cells on a sheet and then locking the sheet, and all of this will match identically to the other workbooks?

yes. each sheet in the one workbook i have completed is the same as each sheet in each of the other workbooks. i started with one file and then copied it and replaced the data for each new site. i forgot about the locking of cells until after i had finished all the reports.

 

[ajm]

This code will lock all the sheets, but will leave all the cells coloured yellow (colorindex=6) unlocked

Sub LockSheets()
  Dim r, sht
  For Each sht In Sheets
    Application.StatusBar = "Protecting " & sht.Name
    sht.Unprotect
    sht.UsedRange.Cells.Locked = True
    For Each r In sht.UsedRange
      If r.Interior.ColorIndex = 6 Then r.Locked = False
    Next r
    sht.Protect
  Next sht
  Application.StatusBar = False
End Sub

You will want a different colour. To get its number, colour a cell, then run this code (with the coloured cell selected)

Sub GetColor()
  MsgBox Selection.Interior.ColorIndex
End Sub

i use colour to identify the cells that my users aren't allowed to touch. this could work nicely. i'll just add to the sht.Protect with a password and other arguments and we're good to go.

 

[ajm]

@gravanoc,@Dermot

thanks for your help. i started building a version of each of the two methods. then, thought it'd be really cool to build a combined version using the ideas from both of your contributions. then realised it was 11.30, the movie had ended, and i had just typed a thousand d's across the page, maybe more. this morning, i was reformatting one of the models with changes i had made to my original (the one with the locked cells already done), and came to the realisation that using the format painter copies the lock settings also. so, now, i am just using it to get my job finished asap. its a sunday and i have been looking at little rectangles all week. i need a break. maybe i'll play some minecraft......