need help to alter code

[rich_cirillo]

Workbook contains 2 sheets...when the workbook closes down it protects the worksheets.Can the following code be altered so that it can still transfer the data from WEEKLY_DATA sheet even when the SCORE sheet is protected.The code transfers the data perfectly if the SCORE sheet is unprotected but gives error if the SCORE Sheet is protected

Thanks

Option Explicit

Dim nmFlag  As Name
    
Sub insert_data()
    
    Dim d, i As Long, k, q, x, r As Long, Rng1 As Range
    Dim c As Long, lRow As Long, Rng2 As Range, Hdr
    
    lRow = Sheets("SCORE").Range("c" & Sheets("SCORE").Rows.Count).End(3).Row
    Set Rng2 = Sheets("SCORE").Range("c3:n" & lRow)
    d = Rng2.Value2
    q = Application.Index(d, 0, 1)
    
    Set Rng1 = Sheets("WEEKLY_GRAPH").Range("B32:m37")
    Hdr = Sheets("WEEKLY_GRAPH").Range("C21:m21")
    If Application.WorksheetFunction.CountA(Rng1) = Rng1.Cells.Count Then
        k = Rng1.Value2
        
        x = Application.Match(k(1, 1), q, 0)
        If Not IsError(x) Then
            If Len(d(x, 2)) * Len(d(x, 3)) Then 'check 2 columns whether they have data in those cells
                MsgBox "It seems data already been entered for date " & CDate(k(1, 1))
                Exit Sub
            Else
                For r = 1 To UBound(k, 1)
                    For c = 1 To UBound(k, 2)
                        d(r + x - 1, c) = k(r, c)
                    Next
                Next
                For c = 2 To UBound(d, 2): d(x - 1, c) = Hdr(1, c - 1): Next
            End If
        Else
            Set Rng2 = Sheets("SCORE").Range("c3:m" & lRow + 9)
            d = Rng2.Value2
            For r = 1 To UBound(k, 1)
                For c = 1 To UBound(k, 2)
                    d(UBound(d, 1) - UBound(k, 1) + r, c) = k(r, c)
                Next
            Next
            For c = 2 To UBound(d, 2): d(UBound(d, 1) - UBound(k, 1), c) = Hdr(1, c - 1): Next
        End If
        Rng2 = d
        Rng2.Columns(1).NumberFormat = "m/d/yyyy"
        With Rng2.Resize(Rng2.Rows.Count + 2, Rng2.Columns.Count)
            .Rows.RowHeight = 30
        End With
        On Error Resume Next
        Set nmFlag = ThisWorkbook.Names("Flag")
        On Error GoTo 0
        If nmFlag Is Nothing Then
            ThisWorkbook.Names.Add "Flag", "TRUE", 1
        Else
            nmFlag.RefersTo = "TRUE"
        End If
        'transfer code ends here. So put the msgbox here.
        MsgBox "Data has been Transferred to Score sheet", vbInformation
    Else
        MsgBox "Cannot transfer until all data entered", vbCritical
    End If
           
End Sub

Protection Code in WEEKLY_DATA Sheet

Private Sub CommandButton1_Click()

    Dim strPassword As String
    Const strActualPassword As String = "ABCD"
    strPassword = InputBox("Please enter the password", "Protect/Unprotect Sheet")
    
    If strActualPassword = strPassword Then
        If Me.CommandButton1.Caption = "PROTECT SHEET" Then
            Me.CommandButton1.Caption = "UNPROTECT SHEET"
            UnlockCells
            Me.Protect Password:=strPassword
        Else
            Me.CommandButton1.Caption = "PROTECT SHEET"
            Me.Unprotect Password:=strPassword
        End If
    Else
        MsgBox "Invalid Password"
    End If
    
End Sub

Sub UnlockCells()

    Me.Range("C21:L21,C32:M36").Locked = False
    
End Sub

Workbook Protection in ThisWorkBook

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim wks As Worksheet
    
    For Each wks In ThisWorkbook.Worksheets
        wks.Protect "ABCD"
    Next wks
    If Not Cancel Then
        Me.Save
    End If
    
End Sub

 

[CharlesChuckieCharles]

I don't believe that you can update a protected spreadsheet, but you can programatically unprotect it ( calling your own code) do the update and then protect it again

 

[rich_cirillo]

Thanks

Could the code be altered so it says "Need to unlock SCORE sheet before transferring Data"....is there anyway also of stopping the de-bugging pop up box opening because SCORE Sheet is protected and with the pop up "Need to unlock SCORE sheet before transferring Data" opening up instead...

Thanks

Rich

 

[rich_cirillo]

Thanks
Can the VBA code be changed for the following to happen - programmatically unprotect it ( calling your own code) do the update and then protect it again

Can the code achieve the above

Thanks

Rich

 

[Jon von der Heyden]

Hi

Have a look at the details of thehttp://msdn.microsoft.com/en-us/library/office/ff840611.aspx Protect method. Protect also takes an argument called UserInterfaceOnly​. If set to true protection will not apply to macro's and thus allow your code to run unhindered.

 

[rich_cirillo]

Hi John

I am unable to open the page (restriction) but from you explain that would work just fine.Unfortunately I am not much experience with code but would it take much for me to alter the code above to get the UserInterfaceOnly to work

thanks for your help

Rich

 

[Jon von der Heyden]

You have this:

wks.Protect "ABCD"

I suggest this:

    Call wks.Protect(Password:="ABCD", UserInterfaceOnly:=True)

And that will only protect the interface and allow macros to work without the protection features affecting it.

Remember this needs to be the same for any occasion where you protect a sheet.

 

[rich_cirillo]

Thank you Jon

 

[rich_cirillo]

Hi
I made the change above but it still did not work unless i unprotected the SCORE sheet.The sheet WEEKLY_GRAPH and SCORE were both protected and it gave the error so when i unprotected SCORE sheet only it worked

Thanks

Code in ThisWorkBook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wks As Worksheet
    
    For Each wks In ThisWorkbook.Worksheets
        Call wks.Protect(Password:="ABCD", UserInterfaceOnly:=True)
    Next wks
    If Not Cancel Then
        Me.Save
    End If
    
End Sub

 

[Jon von der Heyden]

Did you make sure that you set UserIntrefaceOnly = True in all instances where you protect the sheets from VBA?