Unprotect Sheet Then Protect Again

[Legacy 436357]

Hello,

I have this code to put data on the 'Service Log'! sheet. I want to keep that sheet protected but the code won't run unless I keep the sheet unprotected.

Can there be lines added so it will unprotect the 'Service Log'! and protect again please?

Thank you

Sub CopyPasteRows1()

    Dim lr As Long
    Dim r As Long
    Dim nr As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column on Sheet3
    lr = Sheets("2011 Ford F150").Cells(Rows.Count, "C").End(xlUp).Row
    
'   Loop through all rows starting on row 2 on Sheet2
    For r = 2 To lr
        If Sheets("2011 Ford F150").Cells(r, "P") = True Then
'           Find next available row on Sheet2
            nr = Sheets("Service Log").Cells(Rows.Count, "C").End(xlUp).Row + 1
'           Copy data to from columns C-K to Sheet2
            Sheets("2011 Ford F150").Range("C" & r).Resize(, 9).Copy
'           Paste values from columns C-K to Sheet2
            Sheets("Service Log").Cells(nr, "C").PasteSpecial xlPasteValues
'           Remove checkbox from Sheet3
            Sheets("2011 Ford F150").Cells(r, "P") = False
                       
        End If
    Next r
    
'   Clears colums H,I, and K after code runs

        Worksheets("2011 Ford F150").Range("H7:I40").ClearContents
        Worksheets("2011 Ford F150").Range("K7:K40").ClearContents
            
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    MsgBox "Service entries have been posted to 'Service Log'!"
    
End Sub

 

[helivw]

Try
Sheets("Service Log").Unprotect
Sheets("Service Log").Protect

 

[Legacy 436357]

Thank you but where to put them please?

Oh also I would like it to not ask for password.

 

[dmt32]

Hi,
try this update to your code

Sub CopyPasteRows1()
    
    Dim lr As Long, r As Long, nr As Long
    Dim wsServiceLog As Worksheet, ws2011FordF150 As Worksheet
    
    Const wsPassword As String = "MYPASSWORDHERE"
    
    On Error GoTo exitsub
    With ThisWorkbook
        Set wsServiceLog = .Worksheets("Service Log")
        Set ws2011FordF150 = .Worksheets("2011 Ford F150")
    End With
    
    wsServiceLog.Unprotect Password:=wsPassword
    
    With Application
        .ScreenUpdating = False: .EnableEvents = False
    End With
    
'Find last row with data in column on Sheet3
    lr = ws2011FordF150.Cells(ws2011FordF150.Rows.Count, "C").End(xlUp).Row
    
'Loop through all rows starting on row 2 on Sheet2
    For r = 2 To lr
        If ws2011FordF150.Cells(r, "P") = True Then
'
'Copy data to from columns C-K to Sheet2
            ws2011FordF150.Range("C" & r).Resize(, 9).Copy
            
'Find next available row on Sheet2
            nr = wsServiceLog.Cells(wsServiceLog.Rows.Count, "C").End(xlUp).Row + 1
'           Paste values from columns C-K to Sheet2
            wsServiceLog.Cells(nr, "C").PasteSpecial xlPasteValues
            
'Remove checkbox from Sheet3
            ws2011FordF150.Cells(r, "P") = False
            
        End If
        Application.CutCopyMode = False
        Next r
        
        wsServiceLog.Protect Password:=wsPassword
        
'Clears colums H,I, and K after code runs
        ws2011FordF150.Range("H7:I40,K7:K40").ClearContents
        
exitsub:
    With Application
        .ScreenUpdating = True: .EnableEvents = True
    End With
    If Err = 0 Then
        MsgBox "Service entries have been posted to 'Service Log'!", 64, "Entry Complete"
    Else
        MsgBox (Error(Err)), 48, "Error"
    End If
        
End Sub

enter password where shown in red

Dave

 

[Legacy 436357]

Thanks Dave but I want it to run without asking for any passwords please.

Can this be done?

 

[dmt32]

Thanks Dave but I want it to run without asking for any passwords please.

Can this be done?

you will not be asked for a password. Code uses password you specify when protecting / unprotecting sheet

You can protect / unprotect without password if this is what you want

Const wsPassword As String = ""

just set Const string as shown

Dave

 

[Legacy 436357]

I get a popup error message with that:

The password you supplied is not correct. Verify that the CAPS LOCK key is off and be sure to use the correct capitalization.

 

[dmt32]

You have protected your sheet with a password - you need to add the correct password (case sensitive) to Const shown in my first post.

Dave

 

[Legacy 436357]

I have these 2 codes that run without asking:

Sub ProtectWorkbook()
    Dim wsheet As Worksheet
    For Each wsheet In ActiveWorkbook.Worksheets
    wsheet.Protect Password:="password"
    Next wsheet
End Sub

Sub UnProtectWorkbook()
    Dim wsheet As Worksheet
    For Each wsheet In ActiveWorkbook.Worksheets
    wsheet.Unprotect Password:="password"
    Next wsheet
End Sub

 

[dmt32]

you have "password" as your Password.

you would enter it where shown in my post

Const wsPassword As String = "password"

Dave