Incorporating a selection.clearcontents into a selectionchange code on second click

Question

I'm trying to make it so that once a cell is clicked once, it populates, and the second click clears the contents.

It's populating the cell then immediately deleting it in the same event. How do I break the events up?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim r As Long
    If Target.CountLarge > 0 Then Exit Sub
    If Not Intersect(Target, Me.Range("E2:R2")) Is Nothing Then
            On Error GoTo haveError
            Application.EnableEvents = False
            Target.Formula = "PBECR"
            Application.EnableEvents = True
        End If
    If Target.CountLarge = 0 Then Exit Sub
    If Not Intersect(Target, Me.Range("E2:R2")) Is Nothing Then
            Selection.ClearContents
        End If
        Exit Sub
haveError:
    MsgBox "Error: " & Err.Description, vbExclamation
    Application.EnableEvents = True
End Sub

Answer 1

• Note: you have to select other cell before second click, otherwise Worksheet_SelectionChange isn't fired.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim r As Long
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Me.Range("E2:R2")) Is Nothing Then
        On Error GoTo haveError
        Application.EnableEvents = False
        Target.Formula = IIf(Len(Target.Value), "", "PBECR")
        Application.EnableEvents = True
    End If
    Exit Sub
haveError:
    MsgBox "Error: " & Err.Description, vbExclamation
    Application.EnableEvents = True
End Sub

---

I would suggest use following option.

• Click (select) a cell to input PBECR
• Double click a cell to remove content

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim r As Long
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Me.Range("E2:R2")) Is Nothing Then
        On Error GoTo haveError
        Application.EnableEvents = False
        Target.Value = ""
        Application.EnableEvents = True
        Cancel = True
    End If
    Exit Sub
haveError:
    MsgBox "Error: " & Err.Description, vbExclamation
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim r As Long
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Me.Range("E2:R2")) Is Nothing Then
        On Error GoTo haveError
        Application.EnableEvents = False
        If Len(Target.Value) = 0 Then Target.Value = "PBECR"
        Application.EnableEvents = True
    End If
    Exit Sub
haveError:
    MsgBox "Error: " & Err.Description, vbExclamation
    Application.EnableEvents = True
End Sub