Multiple worksheet_change Events in One Worksheet

[mjg777]

Hello,
I would like to have the below code run twice within the same worksheet. As seen now, it's set to place a timestamp in a cell four columns to the left of column "S". I would like to run this a second time and it would need to be 7 columns to the left of column "U". Thanks in advance!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("S:S"), Target)
xOffsetColumn = -4
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub

 

[MickG]

Try this:-

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim WorkRng As Range
 Dim Rng As Range
 Dim xOffsetColumn As Integer
 Static c
 c = c + 1
 xOffsetColumn = IIf(c Mod 2 = 0, -4, -7)
 Set WorkRng = Intersect(Application.ActiveSheet.Range("S:S"), Target)
 
 If Not WorkRng Is Nothing Then
 Application.EnableEvents = False
 For Each Rng In WorkRng
 If Not VBA.IsEmpty(Rng.Value) Then
 Rng.Offset(0, xOffsetColumn).Value = Now
 Rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy, hh:mm:ss"
 Else
 Rng.Offset(0, xOffsetColumn).ClearContents
 End If
 Next
  c = IIf(c = 2, 0, c)
 Application.EnableEvents = True
 End If
 End Sub

 

[mjg777]

Hello – Thank you for your quick response! After replacing the code with your suggestion, column “O” is updating with a timestamp once column “S” is populated with a value. However, column “N” is not populating when column “U” is populated with a value. Both columns “S” & “U” will be populated on each row in my worksheet so I need columns “N” and “O” to populate with corresponding timestamps.

 

[MickG]

Try this:-

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim WorkRng As Range
 Dim Rng As Range
 Dim xOffsetColumn As Integer
 If Not Intersect(Target, Union(Range("S:S"), Range("U:U"))) Is Nothing Then
    Application.EnableEvents = False
    xOffsetColumn = IIf(Target.Column = 19, -4, -7)
        If Not VBA.IsEmpty(Target.Value) Then
            Target.Offset(0, xOffsetColumn).Value = Now
            Target.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy, hh:mm:ss"
        Else
            Target.Offset(0, xOffsetColumn).ClearContents
        End If
    Application.EnableEvents = True
 End If
 End Sub

 

[mjg777]

Works perfectly! Thank you very much for your assistance!

 

[MickG]

You're welcome