Home > Blockchain >  How to delete the content of the 2 cells to the right if active cell does meet criteria
How to delete the content of the 2 cells to the right if active cell does meet criteria

Time:11-11

I have written the following code to input the date in the cell to the right if the active cell = 'yes' or 'no'. This part of the code is working perfectly fine but for some reason when the active cell doesn't meet the criteria then I want it to clear the content of the 2 cells to the right. Any advise would much appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range

' The variable KeyCells contains the cells that will cause an input
'date and time in next 2 cells to the right when active cell is changed.

Set KeyCells = ActiveSheet.ListObjects("VW_P1_P2").ListColumns("C1 Made Contact?").Range

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then

If Target = "Yes" Or Target = "No" Then
    ActiveCell.Offset(-1, 1).Value = Format(Now, "mm/dd/yyyy")
    ActiveCell.Offset(-1, 2).Value = Format(Now, "hh:mm")
Else
    ActiveCell.Offset(-1, 1).ClearContents
    ActiveCell.Offset(-1, 2).ClearContents
End If

End If
End Sub

CodePudding user response:

Several issues/improvements:

  • Use Me to refer to the parent worksheet, instead of ActiveSheet.
  • Avoid using ActiveCell, and instead use Target to refer to the changed cell(s).
  • Range(Target.Address) is redundant. Just use Target.
  • If Target is a multi-cell range, you can't compare it to "Yes" or "No", so use a loop.
  • You're changing the sheet programmatically, so best practice would be to temporarily disable events, and re-enable them at the end.
  • I'd suggest using .ListColumns("C1 Made Contact?").DataBodyRange instead of .ListColumns("C1 Made Contact?").Range. This would exclude the column header C1 Made Contact.
  • Instead of Format(Now, "mm/dd/yyyy"), you could just use Date.
Private Sub Worksheet_Change(ByVal Target As Range)
    ' The variable KeyCells contains the cells that will cause an input
    'date and time in next 2 cells to the right when active cell is changed.
    Dim KeyCells As Range
    Set KeyCells = Me.ListObjects("VW_P1_P2").ListColumns("C1 Made Contact?").DataBodyRange

    Dim rng As Range
    Set rng = Application.Intersect(KeyCells, Target)

    If Not rng Is Nothing Then
       On Error GoTo SafeExit
       Application.EnableEvents = False

       Dim cell As Range
       For Each cell in rng
           If cell.Value = "Yes" Or cell.Value = "No" Then
               cell.Offset(-1, 1).Value = Format(Now, "mm/dd/yyyy") ' or just Date
               cell.Offset(-1, 2).Value = Format(Now, "hh:mm")
           Else
               cell.Offset(-1, 1).ClearContents
               cell.Offset(-1, 2).ClearContents
           End If
       Next
    End If

SafeExit:
    Application.EnableEvents = True
End Sub

EDIT:

If KeyCells is multiple columns in your table, then you could use Union:

With Me.ListObjects("VW_P1_P2")
   Dim KeyCells As Range
   Set KeyCells = Union(.ListColumns("C1 Made Contact?").DataBodyRange, _
                        .ListColumns("C2 Made Contact?").DataBodyRange, _
                        .ListColumns("C3 Made Contact?").DataBodyRange)
End With
  • Related