How to detect if texts are deleted in multiple cells that are not adjacent to each other-CodePudding

I wanted to detect if text/values are being deleted from a number of cells that are not located adjacent to each other so that I can execute a routine when that happens.

In my case as an example I would like to monitor cell E5, E8, E11 and E14 if text has been deleted from these cell. So if E5 has been deleted, I would like to execute subroutine #1. If E8 has been deleted I would like to execute subroutine #2. Subroutine #1 and #2 are different. All the sub-routines are unique in the sense that monitoring E5, E8, E11 and E14 as a range will not work for me.

I don't want to execute the routine if I am adding text to the cell - only deleting things from the cell should trigger the subroutine.

I can only go as far as the following routine - which is not working correctly as it does not make a distinction if I am adding text or deleting text as such. I also do not know how to monitor multiple cells without using a range?

' Private Sub Worksheet_Change(ByVal Target As Range)   
    If Target.Address = "$E$5" Then
    MsgBox "hello"
    End If
End Sub

Could someone please point me in the right direction?

Thanks a bunch.

CodePudding user response：

Please, try the next way:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range: Set rng = Range("E5")
  If Target.cells.Count > 1 Then Exit Sub
  If Not Intersect(Target, Union(rng, rng.Offset(3), rng.Offset(6), rng.Offset(9))) Is Nothing Then
    If Target.Value = "" Then
        Select Case Target.Address(0, 0)
            Case "E5": Debug.Print "E5 is empty" 'mySubrutine1
            Case "E8": Debug.Print "E8 is empty"
            Case "E11": Debug.Print "E11 is empty"
            Case "E14": Debug.Print "E14 is empty"
        End Select
    End If
 End If
End Sub

It analyze only the specified cells and do something only if the modified cell is empty.

It exits in case of multiple cells selection. But, it can be easily adapted to also accept multiple deletions. In fact, the next variant should be able do deal with such a situation:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, C As Range: Set rng = Range("E5")

  If Not Intersect(Target, Union(rng, rng.Offset(3), rng.Offset(6), rng.Offset(9))) Is Nothing Then
    For Each C In Target.cells
        If C.Value = "" Then
            Select Case C.Address(0, 0)
                Case "E5": Debug.Print "E5 is empty" 'mySubrutine1
                Case "E8": Debug.Print "E8 is empty" 'mySubrutine2
                Case "E11": Debug.Print "E11 is empty" 'mySubrutine3
                Case "E14": Debug.Print "E14 is empty" 'mySubrutine4
            End Select
        End If
    Next C
 End If
End Sub