worksheet change event to other sheets

[tomanton]

hi all

I've got multiple worksheets in one s/s and have created a worksheet change event in one and cant find a quick way of applying the code to the sheets?

is it actually possible? or a simple paste/copy?

Thanks

 

[Norie]

Do you want to use the same code for the change event of all the sheets in the workbook?

If you do take a look at the workbook level event SheetChange.

 

[tomanton]

yeah you're right, seems sheetchange to be what I need, but I've received out of stack space error for this

Private Sub workbook_sheetchange(ByVal Sh As Object, ByVal target As Range)
    Dim clickRng As Range
    Dim lastRow As Long
    
    lastRow = Range("e3").End(xlDown).Row
    Set clickRng = Range("a3:d" & lastRow)
    
    If Not Intersect(target, clickRng) Is Nothing And Cells(2, 1).Value = "AD&S Team" Then
        If ActiveCell.Value = 1 Or ActiveCell.Value = 2 Or ActiveCell.Value = 3 Or ActiveCell.Value = 4 Then
        ActiveCell.Value = 0
    Else
        Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 4)).Value = 0
        If ActiveCell.Column = 1 Then
            ActiveCell.Value = 1
        ElseIf ActiveCell.Column = 2 Then
            ActiveCell.Value = 2
        ElseIf ActiveCell.Column = 3 Then
            ActiveCell.Value = 3
        Else
            ActiveCell.Value = 4
        End If
    End If
    End If
End Sub

as I only changed the top bit from worksheetchange

 

[Norie]

Your code is making changes so it's going to call itself.

To prevent that add this at the start of the code,

Application.EnableEvents = False

and this at the end.

Application.EnableEvents = True

By the way instead of using ActiveCell you should use Target as that's a reference to the cell(s) that has been changed.

Similarly you might want to use Sh which is a reference to the sheet the change has been made on.

 

[tomanton]

TThat's brilliant all is working, thanks. I also would like to eliminate the error when two cells are selected. Any ideas?

 

[tomanton]

I've added a piece of code to check the number of cells selected and stop the sub in case more then 1 is selected but exit sub doesn't work and not sure how to get the code work or recover after selecting two or more cells:

Private Sub workbook_sheetselectionchange(ByVal Sh As Object, ByVal target As Range)
Application.EnableEvents = False
    Dim clickRng As Range
    Dim lastRow As Long
    
    lastRow = Range("e3").End(xlDown).Row
    Set clickRng = Range("a3:d" & lastRow)
  
    If InStr(target.Address, ":") > 0 Then
    Exit Sub
    End If
    
    If Not Intersect(target, clickRng) Is Nothing And Cells(2, 1).Value = "AD&S Team" Then
        If target.Value = 1 Or target.Value = 2 Or target.Value = 3 Or target.Value = 4 Then
        target.Value = 0
    Else
        Range(Cells(target.Row, 1), Cells(target.Row, 4)).Value = 0
        If target.Column = 1 Then
            target.Value = 1
        ElseIf target.Column = 2 Then
            target.Value = 2
        ElseIf target.Column = 3 Then
            target.Value = 3
        Else
            target.Value = 4
        End If
    End If
    End If
    
Application.EnableEvents = True
End Sub

 

[tomanton]

I have sorted it out myself just by researching, changed the position of Application.EnableEvents = False and it worked