Home > other >  Excel VBA dual Worksheet_change events not working
Excel VBA dual Worksheet_change events not working

Time:10-08

Having trouble executing both Worksheet_Change events correctly. Image below show my results, when modifying column B, column M does nothing. When modifying column L, column N updates as expected but only on row 2. Every other subsequent change to B or M results in N:2 updating to the current time again. My desired outcome is that when Col B is updated I record a time stamp in Col M and the same when Col L updates that I get a time stamp in Col N. Example of Excel Error

My current code is here:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    
    Dim rng As Range
    Dim rng2 As Range
    
    If Not Intersect(Target, Columns("B"), Target.Parent.UsedRange) Is Nothing Then
        On Error GoTo Safe_Exit
        For Each rng In Intersect(Target, Columns("B"), Target.Parent.UsedRange)
            If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 11).Value2)) Then
            rng.Offset(0, 11) = Now
            ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 11).Value2)) Then
            rng.Offset(0, 11) = vbNullString
            End If
        Next rng
        Application.EnableEvents = True
    End If
    

    ElseIf Not Intersect(Target, Columns("L"), Target.Parent.UsedRange) Is Nothing Then
        On Error GoTo Safe_Exit
        For Each rng2 In Intersect(Target, Columns("L"), Target.Parent.UsedRange)
            If CBool(Len(rng2.Value2)) And Not CBool(Len(rng2.Offset(0, 2).Value2)) Then
                rng2.Offset(0, 2) = Now
            ElseIf Not CBool(Len(rng2.Value2)) And CBool(Len(rng2.Offset(0, 2).Value2)) Then
                rng2.Offset(0, 2) = vbNullString
            End If
        Next rng2
        Application.EnableEvents = True
    End If
Safe_Exit:
End Sub

CodePudding user response:

Mock-up, untested, change of code to simplify as you're doing the same actions in two spots:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim columnLetter as String
    Select Case Target.Column
        Case 2 'B
            columnLetter = "M"
        Case 12 'L
            columnLetter = "N"
        Case Else
            Goto Safe_Exit
    End Select
    Dim loopRng as Range
    For Each loopRng In Range(Cells(Target.Row, Target.Column),Cells(Target.End(xlDown).Row,Target.Column)
        If IsEmpty(loopRng) = True And IsEmpty(Cells(loopRng.Row,columnLetter)) = False Then
            Cells(loopRng.Row,columnLetter) = Now
        ElseIf IsEmpty(loopRng) = False And IsEmpty(Cells(loopRng.Row,columnLetter)) = True Then
            Cells(loopRng.Row,columnLetter) = vbNullString
        End If
    Next loopRng
    'Columns(columnLetter).NumberFormat = "yyyy/mm/dd"
    Application.EnableEvents = True
Safe_Exit:
Application.EnableEvents = True
End Sub

Note that the IsEmpty() = True is important... when using an If case, you need to specify for each condition, otherwise the implicit detection will fail.


Edit1: Removed Intersect from loop, whereas the range i've listed will need corrected... it at least references a specific range, now.

Edit2: Removing .Offset and working with specific column references in cells().

CodePudding user response:

I tried this version of my original code and it started to work for some reason.

 Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("B"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("B"), Target.Parent.UsedRange)
If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 11).Value2)) Then
rng.Offset(0, 11) = Now
ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 11).Value2)) Then
rng.Offset(0, 11) = vbNullString
End If
Next rng
End If
If Not Intersect(Target, Columns("L"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
For Each rng In Intersect(Target, Columns("L"), Target.Parent.UsedRange)
If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 2).Value2)) Then
rng.Offset(0, 2) = Now
ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 2).Value2)) Then
rng.Offset(0, 2) = vbNullString
End If
Next rng
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
  • Related