VBA Run time error 1004 stating a protected sheet when not protected??

willow1985

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
915
Office Version
  1. 365
Platform
  1. Windows
Hello,

I have the below code but am getting run time error 1004: "the cell or chart you're trying to change is on a protected sheet. To make a change, unprotect the sheet. Youu might be requested to enter a password"
However as you can see in the code I already unprotected the sheet prior.

Why am I getting this runtime error if the sheet is unprotected?

Any help would be appreciated.

Thank you :)

VBA Code: 
Sub NewDataBL()
'
' NewDataBL Macro

With ThisWorkbook.Sheets("New BL Data")
If Application.CountIf(.Range("B2:I2"), "") > 0 Then
MsgBox "Please Complete all Fields"
Exit Sub
End If
End With

Dim Msg As String, Ans As Variant

    Msg = "Would you like to update the Batch Log with this Data?"

    Ans = MsgBox(Msg, vbYesNo)

    Select Case Ans

        Case vbYes


Sheets("Batch Log").Select
        Dim lo As ListObject
 
  For Each lo In ActiveSheet.ListObjects
 
    lo.AutoFilter.ShowAllData
      Next lo
Worksheets("Batch Log").Unprotect Password:="SADIE"
Sheets("New BL Data").Select
Range("A2:J2").Select
Selection.Copy
Sheets("Batch Log").Select
Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'GETTING THE ERROR ON THIS LINE'

Worksheets("Batch Log").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, Password:="SADIE"

Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).Select
Sheets("New BL Data").Select
    Range("B2:D2").Select
    Selection.ClearContents
    Range("F2:I2").Select
    Selection.ClearContents
   Range("B2").Select
ActiveWorkbook.Save
MsgBox "New Batch Submitted"

        Case vbNo
        GoTo Quit:
    End Select
Quit:
'
End Sub

Carla
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
Still get the error. It is unprotecting it but for some reason it gives me the error??

The Macro still pastes however and does what it is supposed to do but the warning message that it is a protected sheet (even though it is unprotected) keeps tripping up the code
 
Upvote 0
Well I got around it for now by adding On error resume next.

VBA Code: 
On error resume next
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

But any ideas on how to fix the problem would be much appreciated. I am stumped.
 
Upvote 0
then the problem is occuring after you re-protect it even though its highlighting a line before it.
try moving your code that clears content above protecting the sheet, see if that works.

VBA Code: 
Sub NewDataBL()
'
' NewDataBL Macro

With ThisWorkbook.Sheets("New BL Data")
If Application.CountIf(.Range("B2:I2"), "") > 0 Then
MsgBox "Please Complete all Fields"
Exit Sub
End If
End With

Dim Msg As String, Ans As Variant

    Msg = "Would you like to update the Batch Log with this Data?"

    Ans = MsgBox(Msg, vbYesNo)

    Select Case Ans

        Case vbYes


Sheets("Batch Log").Select
        Dim lo As ListObject
 
  For Each lo In ActiveSheet.ListObjects
 
    lo.AutoFilter.ShowAllData
      Next lo
Worksheets("Batch Log").Unprotect Password:="SADIE"
Sheets("New BL Data").Select
Range("A2:J2").Select
Selection.Copy
Sheets("Batch Log").Select
Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'GETTING THE ERROR ON THIS LINE'

Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).Select
Sheets("New BL Data").Select
    Range("B2:D2").Select
    Selection.ClearContents
    Range("F2:I2").Select
    Selection.ClearContents
   Range("B2").Select
ActiveWorkbook.Save
MsgBox "New Batch Submitted"

Worksheets("Batch Log").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, Password:="SADIE"

        Case vbNo
        GoTo Quit:
    End Select
Quit:
'
End Sub
 
Upvote 0
Not that it should make a difference to your particular issue but what happens if you run the code below?
VBA Code: 
Sub NewDataBL()
    '
    ' NewDataBL Macro

    With ThisWorkbook.Sheets("New BL Data")
        If Application.CountIf(.Range("B2:I2"), "") > 0 Then
            MsgBox "Please Complete all Fields"
            Exit Sub
        End If
    End With

    Dim Msg As String, Ans As Variant

    Msg = "Would you like to update the Batch Log with this Data?"

    Ans = MsgBox(Msg, vbYesNo)

    Select Case Ans

    Case vbYes


'        Sheets("Batch Log").Select
        Dim lo As ListObject
 
        For Each lo In Sheets("Batch Log").ListObjects
 
            lo.AutoFilter.ShowAllData
        Next lo
        Worksheets("Batch Log").Unprotect Password:="SADIE"
        Sheets("New BL Data").Range("A2:J2").Copy
        Sheets("Batch Log").Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues 'GETTING THE ERROR ON THIS LINE'

        'Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).Select
        Sheets("New BL Data").Range("B2:D2").ClearContents
        Sheets("New BL Data").Range("F2:I2").ClearContents
        '   Range("B2").Select
        ActiveWorkbook.Save
        MsgBox "New Batch Submitted"

        Worksheets("Batch Log").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                                                                                          , AllowSorting:=True, AllowFiltering:=True, Password:="SADIE"

    Case vbNo
        GoTo Quit:
    End Select
Quit:
    '
End Sub
 
Upvote 0
BlakeSkate said:
then the problem is occuring after you re-protect it even though its highlighting a line before it.
try moving your code that clears content above protecting the sheet, see if that works.

VBA Code: 
Sub NewDataBL()
'
' NewDataBL Macro

With ThisWorkbook.Sheets("New BL Data")
If Application.CountIf(.Range("B2:I2"), "") > 0 Then
MsgBox "Please Complete all Fields"
Exit Sub
End If
End With

Dim Msg As String, Ans As Variant

    Msg = "Would you like to update the Batch Log with this Data?"

    Ans = MsgBox(Msg, vbYesNo)

    Select Case Ans

        Case vbYes


Sheets("Batch Log").Select
        Dim lo As ListObject

  For Each lo In ActiveSheet.ListObjects

    lo.AutoFilter.ShowAllData
      Next lo
Worksheets("Batch Log").Unprotect Password:="SADIE"
Sheets("New BL Data").Select
Range("A2:J2").Select
Selection.Copy
Sheets("Batch Log").Select
Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'GETTING THE ERROR ON THIS LINE'

Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).Select
Sheets("New BL Data").Select
    Range("B2:D2").Select
    Selection.ClearContents
    Range("F2:I2").Select
    Selection.ClearContents
   Range("B2").Select
ActiveWorkbook.Save
MsgBox "New Batch Submitted"

Worksheets("Batch Log").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, Password:="SADIE"

        Case vbNo
        GoTo Quit:
    End Select
Quit:
'
End Sub
Click to expand...

Unfortunately still got the error with this code
 
Upvote 0
MARK858 said:
Not that it should make a difference to your particular issue but what happens if you run the code below?
VBA Code: 
Sub NewDataBL()
    '
    ' NewDataBL Macro

    With ThisWorkbook.Sheets("New BL Data")
        If Application.CountIf(.Range("B2:I2"), "") > 0 Then
            MsgBox "Please Complete all Fields"
            Exit Sub
        End If
    End With

    Dim Msg As String, Ans As Variant

    Msg = "Would you like to update the Batch Log with this Data?"

    Ans = MsgBox(Msg, vbYesNo)

    Select Case Ans

    Case vbYes


'        Sheets("Batch Log").Select
        Dim lo As ListObject

        For Each lo In Sheets("Batch Log").ListObjects

            lo.AutoFilter.ShowAllData
        Next lo
        Worksheets("Batch Log").Unprotect Password:="SADIE"
        Sheets("New BL Data").Range("A2:J2").Copy
        Sheets("Batch Log").Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues 'GETTING THE ERROR ON THIS LINE'

        'Range("BLTable").Cells(1, 1).End(xlDown).Offset(1).Select
        Sheets("New BL Data").Range("B2:D2").ClearContents
        Sheets("New BL Data").Range("F2:I2").ClearContents
        '   Range("B2").Select
        ActiveWorkbook.Save
        MsgBox "New Batch Submitted"

        Worksheets("Batch Log").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                                                                                          , AllowSorting:=True, AllowFiltering:=True, Password:="SADIE"

    Case vbNo
        GoTo Quit:
    End Select
Quit:
    '
End Sub
Click to expand...

Got the error on this one as well
 
Last edited:
Upvote 0
Which message box do you get with the code below?

VBA Code: 
Sub SheetProtected()
    With Worksheets("Batch Log")
        .Unprotect Password:="SADIE"
        If .ProtectContents Or .ProtectDrawingObjects Or .ProtectScenarios Then
            MsgBox "This worksheet is password protected"
        Else
            MsgBox "This Worksheet is not password protected"
        End If
    End With

End Sub
 
Upvote 0
I see no problem in your code.
Do you have any other macro running on the sheet or in the book's events?

I pass your code a little compacted.

VBA Code: 
Sub NewDataBL()
  ' NewDataBL Macro
  Dim Msg As String, Ans As Variant, lr As Long, sh As Worksheet, lo As ListObject
 
  Application.ScreenUpdating = False
  If Application.CountIf(Sheets("New BL Data").Range("B2:I2"), "") > 0 Then
     MsgBox "Please Complete all Fields"
    Exit Sub
  End If
  Ans = MsgBox("Would you like to update the Batch Log with this Data?", vbYesNo)

  If Ans = vbYes Then
    Set sh = Sheets("Batch Log")
    For Each lo In sh.ListObjects
      lo.AutoFilter.ShowAllData
    Next lo
    
    sh.Unprotect Password:="SADIE"
    sh.ListObjects("BLTable").ListRows.Add AlwaysInsert:=True
    lr = sh.ListObjects("BLTable").ListRows.Count
    Sheets("New BL Data").Range("A2:J2").Copy
    sh.ListObjects("BLTable").DataBodyRange(lr, 1).PasteSpecial xlPasteValues
    sh.Protect Password:="SADIE", DrawingObjects:=True, Contents:=True, _
      Scenarios:=True, AllowSorting:=True, AllowFiltering:=True

    Sheets("New BL Data").Range("B2:D2, F2:I2").ClearContents
    Range("B2").Select
    ActiveWorkbook.Save
    MsgBox "New Batch Submitted"
  End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Using VBA code in a protected excel sheet
Replies
2
Views
468
MagicCarpet
M
A
  • Question Question
VBA help - Locking & unlocking on certain times of day
Replies
4
Views
99
Anthony86
A
M
  • Question Question
Not running code
Replies
0
Views
191
MagicCarpet
M
C
  • Question Question
If User Selects Cancel All Sheets are Unprotected
Replies
4
Views
120
christianbiker
C
N
  • Question Question
VBA - Intersect code being re-initiated
Replies
1
Views
182
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,237
Messages
6,170,924
Members
452,366
Latest member
TePunaBloke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top