VBA Advanced Filter Code not Running on protected sheet

[tazmtiger]

Hi!

When I protect worksheet, code below does not work.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
On Error GoTo errHandler
Dim wsD As Worksheet
Dim wsC As Worksheet
Set wsD = Worksheets("Data Search")
Set wsC = Worksheets("Part Entry")
If Target.Cells.Count > 1 Then Exit Sub
If Target.Address = "$B$3" Or Target.Address = "$C$3" Or Target.Address = "$H$3" Then
wsC.Range("Database") _
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsD.Range("B2:H3"), _
CopyToRange:=wsD.Range("A6:K6"), _
Unique:=False
End If

Exit Sub

errHandler:
Application.EnableEvents = True
MsgBox "Data was not retrieved"

End Sub

Can some one help me protect worksheet and still make code work?

Thank you!

 

[mvptomlinson]

At the beginning of the code un-protect the sheet, and at the end re-protect it.

Sub blahblah()
Sheets("Sheet1").Unprotect Password:="your_pass"
..
other code
..
Sheets("Sheet1").Protect Password:="your_pass"
End Sub

Protect your VBA project with a password if you don't want others readily seeing the sheet password.

 

[sous2817]

Whoops...got auto and advance filter mixed up. Try:

unprotect the sheet @ start, do the filtering, and then reprotect the sheet @ end.

 

[tazmtiger]

At the beginning of the code un-protect the sheet, and at the end re-protect it.

Sub blahblah()
Sheets("Sheet1").Unprotect Password:="your_pass"
..
other code
..
Sheets("Sheet1").Protect Password:="your_pass"
End Sub

Protect your VBA project with a password if you don't want others readily seeing the sheet password.[/Q


Thank you!

Your code worked, but not in that way you illustrated it.

It gave me some out range error your way.

But. I modified the placement, and it worked just fine, as illustrated below:

Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("Data Search").Unprotect Password:="Mypassword"
Application.EnableEvents = True
On Error GoTo errHandler
Dim wsD As Worksheet
Dim wsC As Worksheet
Set wsD = Worksheets("Data Search")
Set wsC = Worksheets("Part Entry")
If Target.Cells.Count > 1 Then Exit Sub
If Target.Address = "$B$3" Or Target.Address = "$C$3" Or Target.Address = "$H$3" Then
wsC.Range("Database") _
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsD.Range("B2:H3"), _
CopyToRange:=wsD.Range("A6:K6"), _
Unique:=False

Sheets("Data Search").Protect Password:="Mypassword"

End If

Exit Sub

errHandler:
Application.EnableEvents = True
MsgBox "Data was not retrieved"

End Sub



Thanks a lot!