Modify Auto Clear - VB Code

Hello,

I have the following code which I am attempting to recycle into another workbook

Private Sub Worksheet_Change(ByVal Target As Range)
' If target is not within D3:D350 then quit
If Intersect(Target, Range("D3:D350")) Is Nothing Then Exit Sub
' Disable event handling while THIS macro is changing the sheet
Application.EnableEvents = False
' if the target cell has just been cleared then clear the entire row
' otherwise put the date in column "H"
Select Case Target.Value
Case Is = Empty
Range(Cells(Target.Row, "H"), Cells(Target.Row, "G")).ClearContents
Case Is <> Empty
Target.Offset(0, 4).Value = Date
End Select
' re-enable event handling and quit
Application.EnableEvents = True

I need to modify this a bit and I am coming up short ...

First .. when a number is entered into D3:D350 the current date will prefill on H3:H350
And as per above if the number in D3:D350 is deleted it then auto clears H & G ... However I would like to clear the entire row.

So if I Delete the number in D3:D350 I would like all data in A, C, E, F, G & H to autoclear.

Hi,

Rows(Target.Row).ClearContents

instead of

Range(Cells(Target.Row, "H"), Cells(Target.Row, "G")).ClearContents

Slight modification needed in this autoclear code ...

I have a vlookup in column B ...

Can we tweak the following code to exclude clearing Column B ?

Because B will clear once there is no data in C

I don't want the below to earse by vlook up formula in Column B

Originally Posted by abousetta

Hi,

Rows(Target.Row).ClearContents

Maybe try:

Cells(Target.Row,"A").ClearContents
Range(Cells(Target.Row, "C"), Cells(Target.Row, "XFD")).ClearContents

Originally Posted by abousetta

Maybe try:

Cells(Target.Row,"A").ClearContents
Range(Cells(Target.Row, "C"), Cells(Target.Row, "XFD")).ClearContents

The above did something funky ... so I just did this messy but it works:

Private Sub Worksheet_Change(ByVal Target As Range)
' If target is not within D3:D350 then quit
  If Intersect(Target, Range("D3:D350")) Is Nothing Then Exit Sub
  ' Disable event handling while THIS macro is changing the sheet
  Application.EnableEvents = False
  ' if the target cell has just been cleared then clear the entire row
  ' otherwise put the date in column "H"
  Select Case Target.Value
  Case Is = Empty
  Cells(Target.Row, "A").ClearContents
  Cells(Target.Row, "C").ClearContents
  Cells(Target.Row, "E").ClearContents
  Cells(Target.Row, "F").ClearContents
  Cells(Target.Row, "G").ClearContents
  Cells(Target.Row, "H").ClearContents
  Case Is <> Empty
       Target.Offset(0, 4).Value = Date
       Select Case Month(Target.Offset(0, 4))
       Case 11, 12, 1
       Cells(Target.Row, 1).Value = "Q1"
       Case 2, 3, 4
       Cells(Target.Row, 1).Value = "Q2"
       Case 5, 6, 7
       Cells(Target.Row, 1).Value = "Q3"
       Case 8, 9, 10
       Cells(Target.Row, 1).Value = "Q4"
 End Select
 End Select
 ' re-enable event handling and quit
 Application.EnableEvents = True
End Sub

*** Part of the code above clears the data in cells when the data is deleted from D
*** Can a pop up be added to asK

"Are you sure you want to clear the data in this row"
With an option:
Yes - exceute code above
No - Does not exectute code to clear

Another way:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r           As Range
    Dim cell        As Range
    Dim sQtr        As String

    Set r = Intersect(Target, Range("D3:D350"))

    If Not r Is Nothing Then
        sQtr = "Q" & WorksheetFunction.Lookup(Month(Date), Array(1, 2, 5, 8, 11), Array(1, 2, 3, 4, 1))
        On Error GoTo Oops
        Application.EnableEvents = False

        For Each cell In r
            If IsEmpty(cell.Value) Then
                Rows(cell.Row).Range("A1,C1,E1:H1").ClearContents
            Else
                Cells(cell.Row, "H").Value = Date
                Cells(cell.Row, "A") = sQtr
            End If
        Next cell

Oops:
        Application.EnableEvents = True
    End If
End Sub