Multiple worksheet change events in one sheet

[nparsons75]

Hi,

I have a worksheet change event that works perfectly as is. Basically it looks for a change within a range and then name and time stamps in to seperate cells. What I need is to have this work numerous times, so I have multiple ranges, and multiple name and time stamp cells per each range. My current code is:

Private Sub Worksheet_Change(ByVal Target As Range)ActiveSheet.Unprotect Password:="******"
Application.EnableEvents = False
If Intersect(Target, Range("A14:z35")) Is Nothing Then Exit Sub
Range("e35").Value = Environ("UserName")
Range("k35").Value = Now
ActiveSheet.Protect Password:="******"
Letscontinue:
Application.EnableEvents = True
Exit Sub
End Sub

I thought I would try this but the second change overides the first.

Private Sub Worksheet_Change(ByVal Target As Range)ActiveSheet.Unprotect Password:="oeestat"
Application.EnableEvents = False
If Intersect(Target, Range("A14:z35")) Is Nothing Then Exit Sub
Range("e35").Value = Environ("UserName")
Range("k35").Value = Now
If Intersect(Target, Range("B42:Z55")) Is Nothing Then Exit Sub
Range("e10").Value = Environ("UserName")
Range("k10").Value = Now
ActiveSheet.Protect Password:="oeestat"
Letscontinue:
Application.EnableEvents = True
Exit Sub
End Sub

Thanks in advance for any help.

 

[Joe4]

You need to get rid of your "EXIT SUB" commands, as if that condition is not met, it will exit the sub and never get to look at anything below it (your other conditions).

So you need to change your approach. Instead of structuring each one like this:

If Intersect(Target, Range("A14:z35")) Is Nothing Then Exit Sub

It needs to be a block like this:

If Not Intersect(Target, Range("A14:z35")) Is Nothing Then
   'steps to perform if target cell found in A14:Z35
End If

So, if you have multiple conditions, you would have multiple blocks like this.

 

[nparsons75]

Superb, works like a charm....Thank you very much for your time.

 

[Joe4]

You are welcome!

 

[sdas34]

I would like to use multiple Worksheet Change code in same worksheet. How to do that? My code is as below:

Private Sub Worksheet_Change(ByVal Target As Range)
'Pivot table filter based on cell value
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("D20:D21")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Set xPFile = xPTable.PivotFields("Designation")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change2(ByVal Target As Range)
'Pivot table filter based on cell value 2
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("H20:H21")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Set xPFile = xPTable.PivotFields("Offering")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

 

[Joe4]

Just like in my previous reply, you can only have one Worksheet_Change event procedure code per worksheet, so you need to combine them into one.
And you need to change the block of the first one so that it does not exit if your first condition is not met.

You can do that by changing this line:

If Intersect(Target, Range("D20:D21")) Is Nothing Then Exit Sub

to this:

If Not Intersect(Target, Range("D20:D21")) Is Nothing Then

and making it an IF...END IF block.

Also, since you are using the same variable names in both blocks, you only want one round of variable declarations.

So your final code will look something like this.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next

'***FIRST CHECK***
'Pivot table filter based on cell value
If Not Intersect(Target, Range("D20:D21")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Designation")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End If

'***SECOND CHECK***
'Pivot table filter based on cell value 2
If Not Intersect(Target, Range("H20:H21")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Offering")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End If

On Error GoTo 0

End Sub

 

[sdas34]

Just like in my previous reply, you can only have one Worksheet_Change event procedure code per worksheet, so you need to combine them into one.
And you need to change the block of the first one so that it does not exit if your first condition is not met.

You can do that by changing this line:

If Intersect(Target, Range("D20:D21")) Is Nothing Then Exit Sub

to this:

If Not Intersect(Target, Range("D20:D21")) Is Nothing Then

and making it an IF...END IF block.

Also, since you are using the same variable names in both blocks, you only want one round of variable declarations.

So your final code will look something like this.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next

'***FIRST CHECK***
'Pivot table filter based on cell value
If Not Intersect(Target, Range("D20:D21")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Designation")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End If

'***SECOND CHECK***
'Pivot table filter based on cell value 2
If Not Intersect(Target, Range("H20:H21")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Offering")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End If

On Error GoTo 0

End Sub

Awesome!! Thanks a lot.

 

[Joe4]

You are welcome.

 

[Hellmonder]

Awesome! many thanks.