1

I am trying to get the target to delete its contents if the selected cell is blank. When I try to delete the contents of the cell within the selected range, excel crashes? I tried adding a cal_loop but I'm not sure if it is helping, not sure how to use it properly... please help!

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Not Intersect(Target, Range("J:J,N:N,Q:Q,U:U,Z:Z,AD:AD,AG:AG")) Is Nothing Then
        If Target.Value <> "" Then
        Debug.Print "Change Detected 1"
        Print
            With Target(1, 2)
            .Value = Date
            End With
        Else
            If Target.Value = "" Then
            Debug.Print "Change Detected 2"
            With Target(1, 2)
            .Value = ""
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

Expecting the contents of target cell to be cleared when I remove the contents of the cell within the selected range.

Edit 1:

Thanks guys! I added Application.EnableEvents = False/True at the beginning/end of the code respectively and removed the cal_loop and that stopped the crashing but now it is like the script is not running at all? Following the suggestions of another article I tried adding a Debug.print to see if I get anything (first time I am using this).. but again nothing happens. Why is that?

Edit 2:

Thanks for the enable events check, that got it working again. I added some comments as suggested to better explain what should be happening. Where it should 'Clear data if target is empty' is not working.

When I delete the contents of the target I expect the offset target (1,2) to be cleared as well.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Not Intersect(Target, Range("J:J,N:N,Q:Q,U:U,Z:Z,AD:AD,AG:AG")) Is Nothing Then
        If Target.Value <> "" Then 'Insert date if target is not empty'
            With Target(1, 2)
            .Value = Date
            End With
        End If
        Else 'Clear date if target is empty'
            If Target.Value = "" Then
            With Target(1, 2)
            .Value = ""
            End With
            End If
    End If
Application.EnableEvents = True
End Sub
  • Excel should not crash even if you got a bug. I experienced something similar and could only solve it by changing some data. In another case, a perfectly working macro crashed when run on a particular machine. Maybe you could schedule a function to do the clear or set the value. That way, the change in the cell will have enough time to terminate before your macro starts changing values. All that said, it's an Excel bug problem. – Tarik Dec 30 '22 at 09:57
  • You check if a user change a value in a cell or clear the value of the cell. I wonder how you "_Expecting the contents of target cell to be cleared_" ? Example : there is a value in cell N5 : "test1". A user change that value into "test2" ---> the macro triggered, it found that the target is not empty `<>""` so it fill cell O5 with a date. Another user clear that "test2" value in cell N5 ... so I think you don't need to clear the "target" cell value as it is already emptied by the user. Except I misunderstood you :). – karma Dec 30 '22 at 10:09
  • btw, in your ELSE statement, I just notice your code `With Target(1, 2): Target.ClearContents: End With`. What did you mean by that ? I think what you want is something like this : there are two range which needed to be checked if any cell within is changed, say rg1 range A2:A10 and rg2 range B2:B10. If a user change a value in A5, then B5 automatically fiiled with date. If a user clear the date value in B5 then A5 automatically cleared. Please CMIIW. – karma Dec 30 '22 at 10:15
  • My other guess : if a user clear the target cell value (in the example case, cell A5), then you want the date value in cell B5 automatically cleared. If this is the case then `Target(1, 2).ClearContents` for your ELSE statement. – karma Dec 30 '22 at 10:20
  • 1
    If you change the value of a cell then the event is triggered again and again and again...forever. Deactivate events and reactivate at the end of your code. – Foxfire And Burns And Burns Dec 30 '22 at 10:23
  • 1
    @FoxfireAndBurnsAndBurns, Thank you for the correction. So it need : `application.enableevents=false` at the beginning and `application.enableevents=true` before the end sub. – karma Dec 30 '22 at 10:24
  • Thanks for your help guys, I edited my original post to reflect some of the changes I implemented based on your comments. I am not getting crashed anymore but now it's like nothing is working! – Matthew Camilleri Dec 30 '22 at 11:00
  • I always recommend the post [Why MS Excel crashes and closes during Worksheet_Change Sub procedure?](https://stackoverflow.com/questions/13860894/why-ms-excel-crashes-and-closes-during-worksheet-change-sub-procedure/13861640#13861640) when working with `Worksheet_Change` – Siddharth Rout Dec 30 '22 at 11:05
  • Also Matt, the code is not working because the events have not been reset. In the immediate window type `Application.EnableEvents = True` and press `Enter` and your code will start working. I have updated the post with this information. See the `Note` section at the end of that post. – Siddharth Rout Dec 30 '22 at 11:14
  • What exactly are you trying to do? It will obviously happen in a row so use columns to describe what should trigger the code i.e. if I clear a cell in `A`..., and what should happen e.g. ... I want cells in columns `E. F. G` cleared or I want to add a time stamp to the cell in column `B`. – VBasic2008 Dec 30 '22 at 11:27
  • Thanks guys! I added some comments to my code as suggested. Enabling events did the trick and got it working again. One last thing I hope - When trying to clear the target, I expect the date to be cleared as well in the else function. I edited the post for you all to see with 'Edit 2'. – Matthew Camilleri Dec 30 '22 at 11:41

1 Answers1

0

A Worksheet Change: A Timestamp For Multiple Columns

The Event Procedure

  • This will allow changes in multiple cells produced by copy/pasting or via VBA.
  • It also contains an error-handling routine that will enable events no matter what happens.
  • It uses the RefCombinedRange function to combine the changed cells into ranges to be modified in one go.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const TARGET_RANGE As String = "J:J,N:N,Q:Q,U:U,Z:Z,AD:AD,AG:AG"
    Const DATE_COLUMN_OFFSET As Long = 1
    
    On Error GoTo ClearError ' start error-handling routine
    
    Dim trg As Range: Set trg = Intersect(Target, Me.Range(TARGET_RANGE))
    If trg Is Nothing Then Exit Sub
    
    Dim rgYes As Range, rgNo As Range, tCell As Range
    
    For Each tCell In trg.Cells
        If Len(CStr(tCell.Value)) > 0 Then ' is not blank
            Set rgYes = RefCombinedRange(rgYes, tCell)
        Else ' is blank
            Set rgNo = RefCombinedRange(rgNo, tCell)
        End If
    Next tCell
    
    Application.EnableEvents = False ' disable events before actually writing
    
    If Not rgYes Is Nothing Then rgYes.Offset(, DATE_COLUMN_OFFSET).Value = Date
    If Not rgNo Is Nothing Then rgNo.Offset(, DATE_COLUMN_OFFSET).ClearContents

ProcExit: ' Exit Routine
    On Error Resume Next ' prevent endless loop if error in the following lines
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub ' don't forget!
ClearError: ' Continue error-handling routine
    Debug.Print "Run-time error '" & Err.Number & "':" & vbLf & Err.Description
    Resume ProcExit ' redirect to exit routine
End Sub

The Helper Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      References a range combined from two ranges.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCombinedRange( _
    ByVal urg As Range, _
    ByVal arg As Range) _
As Range
    If urg Is Nothing Then Set urg = arg Else Set urg = Union(urg, arg)
    Set RefCombinedRange = urg
End Function

Enable Events

  • Using the error-handling routine makes keeping the following nearby unnecessary.
Sub EnableEvents()
    Application.EnableEvents = True
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28