Follow

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use
Contact

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

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

>Solution :

MEDevel.com: Open-source for Healthcare and Education

Collecting and validating open-source software for healthcare, education, enterprise, development, medical imaging, medical records, and digital pathology.

Visit Medevel

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
Add a comment

Leave a Reply

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use

Discover more from Dev solutions

Subscribe now to keep reading and get access to the full archive.

Continue reading