Worksheet_Change event

[BigKev]

I have workbooks, each containing a variable number of worksheets, one for each branch, each containing data for employees of said branch. Another worksheet contains all the data from the other worksheets and is used for data analysis. The column structure of each workbook is identical.

The worksheets allow users to input a percentage against an employee. What I want to do is when a percentage is input for an employee in any of the branch sheets the percentage in the summary sheet is updated automatically.

I know about the Worksheet_Change event but here’s my problem.

I can get it to work if I add the Sub to each of the worksheets but I want to have a Global Sub which is declared only once that will handle the event. I have tried adding a Module and placing the code there but to no avail. It’s not a security issue as there are other functions in the module that work fine.

Also, I want to have the same thing happen in reverse if the percentage is changed in the summary sheet, i.e. the relevant percentage in the relevant branch sheet is updated. This however, seems to cause an infinite loop as changing the second sheet fires the Worksheet_Change event which in turn etc etc.

I know how to update the percentages, how can I get a. The event to fire on a global level within the workbook and b. Inhibit the firing of the event multiple times?

As ever, any and all help is appreciated,

Regards, Kevin Bell

[sdckapr]

Before making changes which will trigger recursive events, add the line:
Application.EnableEvents = False

Which will disable the event triggering. The before the code ends add the line:
Application.EnableEvents = True

to reenable them. If you have error handling, make sure that the handler adds the line:
Application.EnableEvents = True
before leaving the return, since this setting remains even when the code has stopped running

Steve

[HansV]

You can create a Workbook_SheetChange event procedure in the ThisWorkbook module. This will be run whenever a cell in ANY of the worksheets of the workbook is changed. The event procedure looks like this:

Code: Select all

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

End Sub

Sh is an object that represents the Worksheet in which the change occurred; you can use this to control which code runs for a specific sheet. Target is the range consisting of all cells that have been changed, just as in the Worksheet_Change event.

To avoid event code calling itself or other event code, you can use

Application.EnableEvents = False

at the beginning of your event procedure, and

Application.EnableEvents = True

at the end. Don't forget the latter - if you omit it, none of your event procedures will run any more!

So the code could look like this:

Code: Select all

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Application.EnableEvents = False
  Select Case Sh.Name
    Case "SummarySheet"
      ' Code to run if cell on summary sheet was changed goes here
      ...
    Case "IntroSheet", "ListSheet"
      ' We don't want to do anything for these sheets, so no code
    Case Else
      ' Code to run for all other sheets goes here
      ...
  End Select
  Application.EnableEvents = True
End Sub

[BigKev]

Steve and Hans,

Thanks, exactly what I wanted. I assume I add the code to the ThisWorkbook code section in the workbook.

Cheers,
Kevin

[HansV]

Yes, the Workbook_SheetChange event procedure belongs in the ThisWorkbook module (it wouldn't do anything elsewhere).

[BigKev]

Thanks again and now I show my ignorance of Excel VB.

I modified the code as shown:

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Target.Column <> 12 Then Exit Sub

Application.EnableEvents = False

Dim SummarySheet As Worksheet
Dim EmployeeData As Range
Dim Employee As Range

Select Case Sh.Name
Case "Summary"
' Code to run if cell on summary sheet was changed goes here

Case "IntroSheet", "ListSheet"
' We don't want to do anything for these sheets, so no code
Case Else
' Code to run for all other sheets goes here

' Get the Sheet object for the Summary
SummarySheet = ActiveWorkbook.Sheets("Summary")

' Get the Range object for the EmployeeData named range
EmployeeData = SummarySheet.Range("EmployeeData")

' Get the Percentage cell using Vlookup
Employee = WorksheetFunction.VLookup(Target.Value, EmployeeData, 10, False)

' Set the Value to the new input value
Employee.Value = Target.Value
End Select

Application.EnableEvents = True

End Sub

I get Error 91 - Object Variable or With Block Variable not set at the line

SummarySheet = ActiveWorkbook.Sheets("Summary")

The Sheet exists, the Named Range exists. What the **** am I doing wrong?

Cheers,
Kevin

[HansV]

SummarySheet and EmployeeData are objects (of type Range) so you must use the keyword Set to assign them:

Set SummarySheet = ActiveWorkbook.Sheets("Summary")

Set EmployeeData = SummarySheet.Range("EmployeeData")

The result of VLookup is NOT a range but a value. Which cell exactly are you trying to find so that you can set its value?

[BigKev]

Thanks again Hans.

I need the address of the cell holding the Percentage from my EmployeeData named range. The first column holds the EmployeeNumber (Column C), the Percentage is in Column L, hence the 10 in the VlookUp formula.

Cheers,
Kevin

[HansV]

But the target cell contains the percentage; you can't use that to look up the employee. I think you need this:

Code: Select all

        Set Employee = EmployeeData.Columns(1).Find( _
          What:=Target.Offset(0, -9).Value, _
          LookIn:=xlValues, LookAt:=xlWhole)
        Employee.Offset(0, 9).Value = Target.Value

If you find that the event procedure doesn't run any more, it's because the code turned off Application.EnableEvents, but didn't turn it back on due to the error messages. As Jan Karel Pieterse mentioned, it's best to use an error handler, but you can easily turn it on manually:
- In the Visual Basic Editor, press Ctrl+G to activate the Immediate window.
- Type the following line and press Enter:

Application.EnableEvents = True

[HansV]

For what it's worth, here is how I would write the code, including an error handler, and taking into account that the user might change multiple cells at once.

Code: Select all

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim wshSummarySheet As Worksheet
  Dim rngEmployeeData As Range
  Dim rngEmployee As Range
  Dim rngCell As Range

  On Error GoTo ErrHandler
  Application.EnableEvents = False
  Select Case Sh.Name
    Case "Summary"
      ' Code to run if cell on summary sheet was changed goes here
    Case "IntroSheet", "ListSheet"
      ' We don't want to do anything for these sheets, so no code
    Case Else
      ' Code to run for all other sheets goes here
      If Not Intersect(Sh.Columns(12), Target) Is Nothing Then
        ' Get the Sheet object for the Summary
        Set wshSummarySheet = ActiveWorkbook.Sheets("Summary")
        ' Get the Range object for the rngEmployeeData named range
        Set rngEmployeeData = wshSummarySheet.Range("EmployeeData")
        For Each rngCell In Intersect(Sh.Columns(12), Target)
          ' Find the employee
          Set rngEmployee = rngEmployeeData.Columns(1).Find( _
            What:=rngCell.Offset(0, -9).Value, _
            LookIn:=xlValues, LookAt:=xlWhole)
          ' If found, update value in column L
          If Not rngEmployee Is Nothing Then
            rngEmployee.Offset(0, 9).Value = rngCell.Value
          End If
        Next rngCell
      End If
  End Select

ExitHandler:
  Application.EnableEvents = True
  Exit Sub

ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

[BigKev]

Awesome as ever Hans.

It never occurred to me that the user would change more than one cell and even if it had, I would have never figured that out in a million years.

Many thanks,
Kevin

[sdckapr]

It never occurred to me that the user would change more than one cell and even if it had

A very common way is to copy a group of cells and paste them to a new location. Each of the pasted values is a changed cell, but the paste triggers only 1 event with a target that is the range of objects pasted.

Steve

[BigKev]

To conclude this here is what I ended up with.

In each of the non-summary worksheets I created a named range consisting of the SAP Branch ID., e.g. NR01 prefixed with an underscore for the Employee Data in the worksheet when the sheet is generated by the .NET program that interfaces with our system.

I then added/modified the code supplied by Hans and came up with this.

Code: Select all

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    ' Code given from the good people at EileensLounge.com
    
    On Error GoTo ExitHandler
    Dim TestForSummarySheet As Worksheet
    Set TestForSummarySheet = Sheets("Summary")
    On Error GoTo 0
    
    Dim wshSummarySheet As Worksheet
    Dim rngEmployeeData As Range
    Dim rngEmployee As Range
    Dim rngCell As Range
    
    Dim MyRow As Integer
    Dim Mytest As String
    Dim BranchID As String
    Dim BranchName As String
    Dim NamedRangeName As String
    
    On Error GoTo ErrHandler
    Application.EnableEvents = False
    Select Case Sh.Name
      Case "Summary"
        ' Code to run if cell on summary sheet was changed goes here
            If Target.Column <> 13 Then GoTo ExitHandler
            ' Check if the column to the left has a value. If not then we are not in the Employee Data Range
            MyRow = Target.Row
            Mytest = CStr(Range("L" & Format(MyRow, "0")).Value)
            If Mytest = vbNullString Then GoTo ExitHandler
            ' Get the value in Column A
            BranchID = CStr(Range("A" & Format(MyRow, "0")).Value)
            ' Make the Named Range Name
            
            NamedRangeName = "_" & Left(BranchID, 4)
            BranchName = Right(BranchID, Len(BranchID) - 7)
            
            ' Now steal Hans's Code for this range
            If Not Intersect(Sh.Columns(13), Target) Is Nothing Then
              ' Get the Sheet object for the Summary
              Set wshSummarySheet = ActiveWorkbook.Sheets(BranchName)
              ' Get the Range object for the rngEmployeeData named range
              Set rngEmployeeData = wshSummarySheet.Range(NamedRangeName)
              For Each rngCell In Intersect(Sh.Columns(13), Target)
                ' Find the employee
                Set rngEmployee = rngEmployeeData.Columns(1).Find( _
                  What:=rngCell.Offset(0, -9).Value, _
                  LookIn:=xlValues, LookAt:=xlWhole)
                ' If found, update value in column L
                If Not rngEmployee Is Nothing Then
                  rngEmployee.Offset(0, 9).Value = rngCell.Value
                End If
              Next rngCell
            End If
      Case "IntroSheet", "ListSheet"
        ' We don't want to do anything for these sheets, so no code
      Case Else
          If Target.Column <> 12 Then GoTo ExitHandler
        ' Code to run for all other sheets goes here
        If Not Intersect(Sh.Columns(12), Target) Is Nothing Then
          ' Get the Sheet object for the Summary
          Set wshSummarySheet = ActiveWorkbook.Sheets("Summary")
          ' Get the Range object for the rngEmployeeData named range
          Set rngEmployeeData = wshSummarySheet.Range("EmployeeData")
          For Each rngCell In Intersect(Sh.Columns(12), Target)
            ' Find the employee
            Set rngEmployee = rngEmployeeData.Columns(1).Find( _
              What:=rngCell.Offset(0, -9).Value, _
              LookIn:=xlValues, LookAt:=xlWhole)
            ' If found, update value in column L
            If Not rngEmployee Is Nothing Then
              rngEmployee.Offset(0, 9).Value = rngCell.Value
            End If
          Next rngCell
        End If
    End Select
        
ExitHandler:
    Application.EnableEvents = True
    Exit Sub
        
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
    
End Sub

In the Summary sheet, column A holds the Branch ID concatenated with ' - ' and the Branch Name which is also the sheet name. It was then simple to modify Hans's code.

It works like an absolute charm.

Thank you so much Hans and everybody else who posted.

[HansV]

Thanks for posting the complete code!

Just two small remarks:

- You can omit the line:

On Error GoTo 0

- You can also omit the following lines, they were just an example:

Code: Select all

      Case "IntroSheet", "ListSheet"
        ' We don't want to do anything for these sheets, so no code

[BigKev]

My posted 'final' code works fine if the user only changes cells for Employees for a single Branch in the Summary Sheet. If the user changes cells for Employees of multiple branches it fails.

This code fixes the problem.

Code: Select all

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    ' Code to update the percentages in all worksheets when a single value is changed
    ' Credit to Hans at Eileen's Lounge.
    On Error GoTo ExitHandler
    Dim TestForSummarySheet As Worksheet
    Set TestForSummarySheet = Sheets("Summary")
    If TestForSummarySheet Is Nothing Then Exit Sub
    
    Dim wshSummarySheet As Worksheet
    Dim rngEmployeeData As Range
    Dim rngEmployee As Range
    Dim rngCell As Range
    
    Dim MyRow As Integer
    Dim BranchID As String
    Dim BranchName As String
    Dim NamedRangeName As String
    
    On Error GoTo ErrHandler
    Application.EnableEvents = False
    Select Case Sh.Name
        Case "Summary"
            ' Code to run if cell on summary sheet was changed goes here
            For Each rngCell In Target
                If rngCell.Column <> 13 Then GoTo ExitHandler
                ' Find the employee
                MyRow = rngCell.Row
                ' Get the value in Column A
                BranchID = CStr(Range("A" & Format(MyRow, "0")).Value)
                ' Make the Named Range Name
                
                NamedRangeName = "_" & Left(BranchID, 4)
                BranchName = Right(BranchID, Len(BranchID) - 7)
                
                ' Get the Sheet object for the Summary
                Set wshSummarySheet = ActiveWorkbook.Sheets(BranchName)
                ' Get the Range object for the rngEmployeeData named range
                Set rngEmployeeData = wshSummarySheet.Range(NamedRangeName)
                  Set rngEmployee = rngEmployeeData.Columns(1).Find(What:=rngCell.Offset(0, -9).Value, LookIn:=xlValues, LookAt:=xlWhole)
                  ' If found, update value in column L
                  If Not rngEmployee Is Nothing Then
                    rngEmployee.Offset(0, 9).Value = rngCell.Value
                  End If
            Next rngCell
        Case Else
        If Target.Column <> 12 Then GoTo ExitHandler
        ' Code to run for all other sheets goes here
        If Not Intersect(Sh.Columns(12), Target) Is Nothing Then
            ' Get the Sheet object for the Summary
            Set wshSummarySheet = ActiveWorkbook.Sheets("Summary")
            ' Get the Range object for the rngEmployeeData named range
            Set rngEmployeeData = wshSummarySheet.Range("EmployeeData")
            For Each rngCell In Intersect(Sh.Columns(12), Target)
                ' Find the employee
                Set rngEmployee = rngEmployeeData.Columns(1).Find( _
                What:=rngCell.Offset(0, -9).Value, _
                LookIn:=xlValues, LookAt:=xlWhole)
                ' If found, update value in column L
                If Not rngEmployee Is Nothing Then
                    rngEmployee.Offset(0, 9).Value = rngCell.Value
                End If
            Next rngCell
        End If
    End Select
        
ExitHandler:
    Application.EnableEvents = True
    Exit Sub
        
ErrHandler:
    MsgBox Err.Description, vbExclamation, "Unexpected Error"
    Resume ExitHandler
    
End Sub

Cheers,
Kevin

[HansV]

Thanks!