Worksheet_Change (running all the time)

[EEEEEE]

Hi,
I would like to run macro when cell D4 is changed by dropdown box (rename the sheet to the value in D4 & run a filter to hide rows).

But the code I have tried to 'put' together works when any cell is changed on the sheet which is slowing down data entry. Kindly assist keeping in mind that i'm a novice. Thanks

CODE:

Private Sub Worksheet_Change(ByVal Target As Range)

'Renames sheet to value in D4
Set Target = Range("D4")
If Target = "" Then Exit Sub
On Error GoTo ErrHandler1:
Application.ActiveSheet.Name = VBA.Left(Target, 31)




'Registers password name
'Sets sheet password
sheetpassword = "horse"

'Sets Sheet Name variable
Sheetname = ActiveSheet.Name
'unlock sheet - must specify sheet name
Worksheets(Sheetname).Unprotect Password:=sheetpassword

'Hides rows
Range("A6:AP1007").Select
Selection.AutoFilter
ActiveSheet.Range("$A$6:$AP$1007").AutoFilter Field:=1, Criteria1:="<>"

'locks the sheet
Worksheets(Sheetname).Protect Password:=sheetpassword




Exit Sub




ErrHandler1: 'incase of error
MsgBox ("Your sheet name was unable to be renamed as you have another sheet with the same name, rename please")
Exit Sub




End Sub

 

[jproffer]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

'Renames sheet to value in D4

On Error GoTo ErrHandler1:
If Not Intersect(Target, Range("D4")) Is Nothing Then
Application.ActiveSheet.Name = Left(Target, 31)




'Registers password name
'Sets sheet password
sheetpassword = "horse"

'Sets Sheet Name variable
Sheetname = ActiveSheet.Name
'unlock sheet - must specify sheet name
Worksheets(Sheetname).Unprotect Password:=sheetpassword

'Hides rows
Range("A6:AP1007").AutoFilter
ActiveSheet.Range("$A$6:$AP$1007").AutoFilter Field:=1, Criteria1:="<>"

'locks the sheet
Worksheets(Sheetname).Protect Password:=sheetpassword




Exit Sub



ErrHandler1: 'incase of error
MsgBox ("Your sheet name was unable to be renamed as you have another sheet with the same name, rename please")


End If


End Sub

But remember, no matter what the error is, it's going to tell your user they have a sheet named "XYZ" already, and they need to pick a different name. That's what you had, so I didn't change it...and it should only fire on D4 now, but....just so you're aware.

EDIT: Upon further testing, it's still firing on all cells....doing a little more testing to see what's going on.

EDIT 2: Had an "End IF" in the wrong place...my fault. Try the edited code above now.

 

[JLGWhiz]

Or this

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("D4")) Is Nothing Then
    'Renames sheet to value in D4
    If Target = "" Then Exit Sub
    On Error GoTo ErrHandler1:
    Application.ActiveSheet.Name = VBA.Left(Target, 31)
    'Registers password name
    'Sets sheet password
    sheetpassword = "horse"
    'Sets Sheet Name variable
    Sheetname = ActiveSheet.Name
    'unlock sheet - must specify sheet name
    Worksheets(Sheetname).Unprotect Password:=sheetpassword
    'Hides rows
    Range("$A$6:$AP$1007").AutoFilter Field:=1, Criteria1:="<>"
    'locks the sheet
    Worksheets(Sheetname).Protect Password:=sheetpassword
    Exit Sub
ErrHandler1:  'incase of error
     If Err.Number > 0 Then
         MsgBox ("Your sheet name was unable to be renamed as you have another sheet with the same name, rename please")
         Err.Clear
     End If    
End If
End Sub

 

[EEEEEE]

Okay so that is much much quicker, thanks heaps JLGWHIZ. Thanks also to jproffer for responding. I spent ages trying to fix it. Awesome.

 

[JLGWhiz]

Okay so that is much much quicker, thanks heaps JLGWHIZ. Thanks also to jproffer for responding. I spent ages trying to fix it. Awesome.

Glad we could help,
regards, JLG