I have a workbook that some very non-technical people will be entering data into. In the past, I've had them type over formulas and otherwise screw up the data, so I've locked everything except where they're supposed to enter data, then I've password protected the workbook and worksheet. Unfortunately, Microsoft, in their infinite wisdom, decided that paste was a function that should be disabled in a protected worksheet/workbook (at least in Excel 2010).
Now, I've discovered that someone's been keeping data in their own workbook and needs to transfer it to mine, since mine is the official one. I borrowed this code from the internet, and have tweaked it a bit to more accurately apply to my particular situation. The code works just fine, however, it's quite rather slow, and I believe that it's the two loops that are killing performance.
I know there are a lot of other things that can be tweaked (Hungarian notation FTL), but I'm not concerned about those at the moment, I need to make this work faster and get it to the end user so she can copy/paste about 200 rows of data (in 3 groups of columns, due to the structure of the data) ASAP. I'll clean up the other little things with the help of RubberDuck once I've got it out the door. (Yes, I understand that's the wrong way about it, but time is of the essence.)
Here's the code:
Private Sub UnProtectPasteToSheet() On Error GoTo ErrHandler Dim bProtected As Boolean Dim oSheet As Worksheet Dim oTempSheet As Worksheet Dim sPasteLocation As String Dim oCell As Range Dim oCollAddress As New Collection Dim oCollValue As New Collection Dim iCount As Integer ' check protection status If Not ThisWorkbook.ActiveSheet.ProtectContents Then Selection.PasteSpecial Paste:=xlAll Else Set oSheet = ThisWorkbook.ActiveSheet 'first unprotect the workbook so we can add the worksheet Dim ProtectStructure As Boolean Dim ProtectWindows As Boolean ToggleWorkbookProtection TheBook:=ThisWorkbook, Structure:=ProtectStructure, Window:=ProtectWindows, ProtectTheBook:=False ' save paste location sPasteLocation = Selection.Address ' unprotecting clears Clipboard in Excel!! strange but true.. ' So paste it to a new sheet before unprotecting Set oTempSheet = ThisWorkbook.Worksheets.Add ' oSheet.Visible = xlSheetVeryHidden oTempSheet.Paste 'then unprotect the sheet after storing off the pasted data oSheet.Unprotect Password:=MY_PWD bProtected = True ' make a note of all locked cells For Each oCell In oSheet.UsedRange If oCell.Locked Then oCollAddress.Add oCell.Address oCollValue.Add oCell.Value End If Next ' paste oTempSheet.UsedRange.Copy oSheet.Activate oSheet.Range(sPasteLocation).Select ' you need to paste only values since pasting format will lock all those cells ' since in Excel default status is "Locked" Selection.PasteSpecial xlValues ' remove temp sheet Application.DisplayAlerts = False oTempSheet.Delete Application.DisplayAlerts = True ' restore locked cells For iCount = 1 To oCollAddress.Count Range(oCollAddress.Item(iCount)) = oCollValue.Item(iCount) Next ' restore protection oSheet.Protect Password:=MY_PWD If ProtectStructure Or ProtectWindows Then ToggleWorkbookProtection TheBook:=ThisWorkbook, Structure:=ProtectStructure, Window:=ProtectWindows, ProtectTheBook:=True End If End If Exit Sub ErrHandler: Debug.Print Err.Description If bProtected Then ThisWorkbook.ActiveSheet.Protect End If End Sub Private Sub ToggleWorkbookProtection(ByRef TheBook As Workbook, ByRef Structure As Boolean, ByRef Window As Boolean, ByVal ProtectTheBook As Boolean) If ProtectTheBook Then TheBook.Protect Structure:=Structure, Windows:=Window, Password:=MY_PWD Else Structure = TheBook.ProtectStructure Window = TheBook.ProtectWindows If Structure Or Window Then 'only attempt to unprotect if it's protected. TheBook.Protect Structure:=False, Windows:=False, Password:=MY_PWD End If End If End Sub