Worksheet Change "code"

[KimberlyC]

Hi

I'm using the following code that is executed when there is a change to the
worksheet ( With the help of this group.....thank you!!)

Private Sub Worksheet_Change(ByVal Target As Range)
With ActiveSheet
If .Index = 1 Then
MsgBox "No sheets to the left"
Else
Set mysheet = Worksheets(.Index - 1)
End If
End With

ActiveSheet.Unprotect Password:="test"
If Not Application.Intersect(Target, _
Range("A8:A501")) Is Nothing Then
mysheet.Range("a8:a47").ClearContents
gCopyUnique Range("A8:A501"), mysheet.Range("A8")
End If
ActiveSheet.Unprotect Password:="test"
mysheet.Range("A8:A47").Sort Key1:=mysheet.Range("A8"),
Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Protect Password:="test", DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Sub

Here's my problem:
I only want this code to run when certain cells are changed on the
worksheet.
The range of cells is A8500.


Not sure if this is possible...but...
The reason for this...is .... I am running code that copies add'l worksheets
to a template file from an addin file. The worksheets being copied have the
same code above behind the worksheets.....which is fine.....but..there is
add'l code that runs when these worksheets are copied to the active workbook
that poplulates certain cells in these worksheets....which casues the
"worksheet change" code to run and this casues all kinds errors...as it's
trying to sort worksheets that it's not and so on..

So.. I'm thinking if I could just run the code only if certain cells are
changed...that would eliminate the erros when the other code runs to
poplulate the cells when they are copied from the addin file...as these
cells would not be in the A8500 range.

Thanks in advance for your help!!
Kimberly

 

[Dave Peterson]

You could have the code that populates the cells in those new worksheets turn
off excel's monitoring of changes (and all event handling):

application.enableevents = false
'your code that does lots of work
application.enableevents = true

I think I'd stay away from Activesheet in your code. Since the code is behind
the worksheet you want to use, you can use the "me" keyword. It refers to the
thing owning the code--in this case, it'll be that worksheet.

And if you have chart sheets (or any other kind of non-worksheet) to the left of
your worksheet, then you may not get what you want.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mySheet As Worksheet

With Me
If .Index = 1 Then
MsgBox "No sheets to the left"
Exit Sub 'get out and do nothing
Else
Set mySheet = Worksheets(.Index - 1)
End If

If Application.Intersect(Target, .Range("A8:A501")) Is Nothing Then
Exit Sub 'get out
End If

'do the work
.Unprotect Password:="test"
mySheet.Range("a8:a47").ClearContents
'gCopyUnique .Range("A8:A501"), mySheet.Range("A8")
.Range("A8:A501").Copy _
Destination:=mySheet.Range("A8")
.Protect Password:="test", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
End With

With mySheet
.Range("A8:A47").Sort Key1:=.Range("A8"), Order1:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With

End Sub

There is a workbook_SheetChange event that can be used for changes to any and
all worksheets--that way you don't have to have the same code behind each sheet.

When I was modifying this, I thought that the sheet you had to unprotect was
gonna be the previous worksheet (mySheet).

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim mySheet As Worksheet

With Sh
If .Index = 1 Then
MsgBox "No sheets to the left"
Exit Sub 'get out and do nothing
Else
Set mySheet = Worksheets(.Index - 1)
End If

If Application.Intersect(Target, .Range("A8:A501")) Is Nothing Then
Exit Sub 'get out
End If
End With

With mySheet
'do the work
.Unprotect Password:="test"

Application.EnableEvents = False

.Range("a8:a47").ClearContents

'gCopyUnique sh.Range("A8:A501"), .Range("A8")
'For testing--since I don't have gCopyUnique!
Sh.Range("A8:A501").Copy _
Destination:=.Range("A8")

.Range("A8:A47").Sort Key1:=.Range("A8"), Order1:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

.Protect Password:="test", DrawingObjects:=True, _
Contents:=True, Scenarios:=True

Application.EnableEvents = True
End With

End Sub

If I guess correctly at the protection stuff, then maybe this version of the
individual sheet would be closer to what you want:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim mySheet As Worksheet

With Me
If .Index = 1 Then
MsgBox "No sheets to the left"
Exit Sub 'get out and do nothing
Else
Set mySheet = Worksheets(.Index - 1)
End If

If Application.Intersect(Target, .Range("A8:A501")) Is Nothing Then
Exit Sub 'get out
End If
End With

With mySheet
'do the work
.Unprotect Password:="test"

Application.EnableEvents = False

.Range("a8:a47").ClearContents

'gCopyUnique sh.Range("A8:A501"), .Range("A8")

Me.Range("A8:A501").Copy _
Destination:=.Range("A8")

.Range("A8:A47").Sort Key1:=.Range("A8"), Order1:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

.Protect Password:="test", DrawingObjects:=True, _
Contents:=True, Scenarios:=True

Application.EnableEvents = True
End With

End Sub

(Notice that the procedure name changed and the "sh" changed back to "me".)