Unlock & Lock Sheets Macro

**eduardbirkaya** · 01-24-2017, 09:58 AM

Hello all,

I am trying to find a solution to my workbook, I have a macro that moves entire rows between tabs that I created for my work place (with your guy's help). However at current state the macro will not work if the given sheet (tab) is locked, I am looking for a work around by either ignoring the locked tabs (ideally) or unlocking and then locking the individual tab post the movement.

Here is the code I am using:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim rng As Range
        Set rng = Target.Parent.Range("O2:O1000")
            If Target.Count > 1 Then Exit Sub
            If Intersect(Target, rng) Is Nothing Then Exit Sub
            Select Case Target.Text
                Case "Boxing"
                    Target.EntireRow.Copy Sheets("Boxing").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "HPC"
                    Target.EntireRow.Copy Sheets("HPC").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Slipcoat"
                    Target.EntireRow.Copy Sheets("Slipcoat").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Innova"
                    Target.EntireRow.Copy Sheets("Innova").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "EmboPoly"
                    Target.EntireRow.Copy Sheets("EmboPoly").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Complete"
                    Target.EntireRow.Copy Sheets("Complete").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Project Hopper"
                    Target.EntireRow.Copy Sheets("Project Hopper").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Cancel"
                    Target.EntireRow.Copy Sheets("Cancel").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case Is = ""
                    Target.EntireRow.Copy Sheets("Idea Entry").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
            End Select
End Sub

Any suggestions? Thank you for your time! :-)

**Arkadi** · 01-24-2017, 10:18 AM

This would do it I think... but it does assume that the sheet is protected without password, you will have to add the password in quotes behind the .unprotect and .protect lines if you need to specify one.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim rng As Range
    Dim isprotected As Boolean
        Set rng = Target.Parent.Range("O2:O1000")
            If Target.Count > 1 Then Exit Sub
            If Intersect(Target, rng) Is Nothing Then Exit Sub
            isprotected = Sh.ProtectContents
            If isprotected = True Then Sh.Unprotect
                        Select Case Target.Text
                Case "Boxing"
                    Target.EntireRow.Copy Sheets("Boxing").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "HPC"
                    Target.EntireRow.Copy Sheets("HPC").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Slipcoat"
                    Target.EntireRow.Copy Sheets("Slipcoat").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Innova"
                    Target.EntireRow.Copy Sheets("Innova").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "EmboPoly"
                    Target.EntireRow.Copy Sheets("EmboPoly").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Complete"
                    Target.EntireRow.Copy Sheets("Complete").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Project Hopper"
                    Target.EntireRow.Copy Sheets("Project Hopper").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Cancel"
                    Target.EntireRow.Copy Sheets("Cancel").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case Is = ""
                    Target.EntireRow.Copy Sheets("Idea Entry").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
            End Select
            If isprotected = True Then Sh.Protect
End Sub

If you want to ignore locked tabs (meaning skip the code for any locked sheet), then change

If isprotected = True Then Sh.Unprotect

to

If isprotected = True Then Exit Sub

and remove

If isprotected = True Then Sh.Protect

from the end

**eduardbirkaya** · 01-24-2017, 10:38 AM

Hello Arkadi,

In what format would I type the password behind the .unprotect and .protect (I am using "temp" as the current password). Sorry I am a noob when it comes to this.

Thank you!

**Arkadi** · 01-24-2017, 10:55 AM

just in quotes behind the command:

If isprotected = True Then Sh.Unprotect "temp"

and

If isprotected = True Then Sh.Protect "temp"

or you can use the actual name of the parameter but don't have to:

If isprotected = True Then Sh.Unprotect Password:="temp"

and

If isprotected = True Then Sh.Protect Password:="temp"

**eduardbirkaya** · 01-24-2017, 11:21 AM

When I am using this, I am getting the following error:

Run-time error '1004'

The cell or chart that you are trying to change is protected and therefore read-only

To modify a protected cell or chart, first remove protection using the unprotected sheet command (review tab, changes group). You may be prompted for a password.

I used the following code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim rng As Range
    Dim isprotected As Boolean
        Set rng = Target.Parent.Range("O2:O1000")
            If Target.Count > 1 Then Exit Sub
            If Intersect(Target, rng) Is Nothing Then Exit Sub
            isprotected = Sh.ProtectContents
            If isprotected = True Then Sh.Unprotect Password:="temp"
                        Select Case Target.Text
                Case "Boxing"
                    Target.EntireRow.Copy Sheets("Boxing").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "HPC"
                    Target.EntireRow.Copy Sheets("HPC").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Slipcoat"
                    Target.EntireRow.Copy Sheets("Slipcoat").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Innova"
                    Target.EntireRow.Copy Sheets("Innova").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "EmboPoly"
                    Target.EntireRow.Copy Sheets("EmboPoly").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Complete"
                    Target.EntireRow.Copy Sheets("Complete").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Project Hopper"
                    Target.EntireRow.Copy Sheets("Project Hopper").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case "Cancel"
                    Target.EntireRow.Copy Sheets("Cancel").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                Case Is = ""
                    Target.EntireRow.Copy Sheets("Idea Entry").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
            End Select
            If isprotected = True Then Sh.Protect Password:="temp"
End Sub

**Arkadi** · 01-24-2017, 11:26 AM

wow I'm stupid... just realized the sheets that are protected are others, not necessarily the one being changed.... let me get back to you in a few.

**Arkadi** · 01-24-2017, 11:48 AM

originally I took care of the scenario where the source sheet was locked, and the row deletion would be stopped by the protection, but it did not account for each individual other sheet (destinations) to be protected. Give this a try (assumes all sheets have temp as the password, change those as needed.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim rng As Range
    Dim isprotected As Boolean
    Dim isprotected2 As Boolean
        Set rng = Target.Parent.Range("O2:O1000")
            If Target.Count > 1 Then Exit Sub
            If Intersect(Target, rng) Is Nothing Then Exit Sub
            isprotected2 = Sh.ProtectContents
            If isprotected2 = True Then Sh.Unprotect Password:="temp"
                        Select Case Target.Text
                Case "Boxing"
                    isprotected = Sheets("Boxing").ProtectContents
                    If isprotected = True Then Sheets("Boxing").Unprotect Password:="temp"
                    Target.EntireRow.Copy Sheets("Boxing").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                    If isprotected = True Then Sheets("Boxing").Protect Password:="temp"
                Case "HPC"
                    isprotected = Sheets("HPC").ProtectContents
                    If isprotected = True Then Sheets("HPC").Unprotect Password:="temp"
                    Target.EntireRow.Copy Sheets("HPC").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                    If isprotected = True Then Sheets("HPC").Protect Password:="temp"
                Case "Slipcoat"
                    isprotected = Sheets("Slipcoat").ProtectContents
                    If isprotected = True Then Sheets("Slipcoat").Unprotect Password:="temp"
                    Target.EntireRow.Copy Sheets("Slipcoat").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                    If isprotected = True Then Sheets("Slipcoat").Protect Password:="temp"
                Case "Innova"
                    isprotected = Sheets("Innova").ProtectContents
                    If isprotected = True Then Sheets("Innova").Unprotect Password:="temp"
                    Target.EntireRow.Copy Sheets("Innova").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                    If isprotected = True Then Sheets("Innova").Protect Password:="temp"
                Case "EmboPoly"
                    isprotected = Sheets("EmboPoly").ProtectContents
                    If isprotected = True Then Sheets("EmboPoly").Unprotect Password:="temp"
                    Target.EntireRow.Copy Sheets("EmboPoly").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                    If isprotected = True Then Sheets("EmboPoly").Protect Password:="temp"
                Case "Complete"
                    isprotected = Sheets("Complete").ProtectContents
                    If isprotected = True Then Sheets("Complete").Unprotect Password:="temp"
                    Target.EntireRow.Copy Sheets("Complete").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                    If isprotected = True Then Sheets("Complete").Protect Password:="temp"
                Case "Project Hopper"
                    isprotected = Sheets("Project Hopper").ProtectContents
                    If isprotected = True Then Sheets("Project Hopper").Unprotect Password:="temp"
                    Target.EntireRow.Copy Sheets("Project Hopper").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                    If isprotected = True Then Sheets("Project Hopper").Protect Password:="temp"
                Case "Cancel"
                    isprotected = Sheets("Cancel").ProtectContents
                    If isprotected = True Then Sheets("Cancel").Unprotect Password:="temp"
                    Target.EntireRow.Copy Sheets("Cancel").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                    If isprotected = True Then Sheets("Cancel").Protect Password:="temp"
                Case Is = ""
                    isprotected = Sheets("Idea Entry").ProtectContents
                    If isprotected = True Then Sheets("Idea Entry").Unprotect Password:="temp"
                    Target.EntireRow.Copy Sheets("Idea Entry").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    Target.EntireRow.Delete
                    If isprotected = True Then Sheets("Idea Entry").Protect Password:="temp"
            End Select
            If isprotected2 = True Then Sh.Protect Password:="temp"
End Sub

**eduardbirkaya** · 01-24-2017, 12:07 PM

Thank you very much Arkadi! this worked like a charm :-)

**Arkadi** · 01-24-2017, 12:17 PM

Glad to hear it

Thanks for marking as solved, and for the rep!

Unlock & Lock Sheets Macro

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Unlock & Lock Sheets Macro

Re: Unlock & Lock Sheets Macro

Re: Unlock & Lock Sheets Macro

Re: Unlock & Lock Sheets Macro

Re: Unlock & Lock Sheets Macro

Re: Unlock & Lock Sheets Macro

Re: Unlock & Lock Sheets Macro

Re: Unlock & Lock Sheets Macro

Re: Unlock & Lock Sheets Macro

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] unlock sheets apply macro then lock sheets again

Lock and unlock sheets with password , diffrent usernames different actions

Macro to lock/unlock computer

VBA to unlock cells, run macro then re-lock them

Lock and Unlock sheets in a shared workbook?

Lock and Unlock Sheets based on Cell values

using VB code to unlock and lock different areas on multiple sheets

Bookmarks

Bookmarks

Posting Permissions