Delete cell contents if not today's date in adjacent cells

[kelly mort]

I have a table in the range B4 : N1004 .

Column E contains values and F contains Dates.

And G contains values and H dates etc to N .

I am looking for a script that will look at column F for dates other than today's date. Cells that don't have today's date, clear that cell and the adjacent cell to the left.

So if cell F5 does not contain today's date, then we clear it's content and the content of E5 in that order.

Thanks in advance

 

[Osvaldo Palmeiro]

Try:

Sub ClearNotToday()
 Application.ScreenUpdating = False
  With ActiveSheet
   .AutoFilterMode = False
   .[B4:N4].AutoFilter 5, "<>" & CLng(Date)
   .[E5:F1004] = ""
   .AutoFilterMode = False
  End With
 Application.ScreenUpdating = True
End Sub

 

[cooper645]

No solution when I started working on this, so I'll add mine anyhow; (I assume column B has always got a value in, this should keep the range dynamic)

Option Explicit

Sub a1084411()
'https://www.mrexcel.com/forum/excel-questions/1084411-delete-cell-contents-if-not-todays-date-adjacent-cells.html
Dim r As Integer, c As Integer, LRow As Long


Application.ScreenUpdating = False


LRow = Cells(Rows.Count, "B").End(xlUp).Row


For c = 6 To 14 Step 2
    For r = LRow To 5 Step -1
        If Cells(r, c).Value <> Date Then Range(Cells(r, c - 1), Cells(r, c)).ClearContents
    Next r
Next c


Application.ScreenUpdating = True


End Sub

 

[Osvaldo Palmeiro]

So if cell F5 does not contain today's date, then we clear it's content and the content of E5 in that order.

If I misunderstood that, so you meant you want to apply the code to all the columns with dates in them ( columns F, H, J, L and N), then:

Sub ClearNotTodayV2()
 Dim k As Long
 Application.ScreenUpdating = False
  For k = 5 To 13 Step 2
   With ActiveSheet
    .AutoFilterMode = False
    .[B4:N4].AutoFilter k, "<>" & CLng(Date)
    .Cells(5, k).Resize(1000, 2).Value = ""
    .AutoFilterMode = False
   End With
  Next k
 Application.ScreenUpdating = True
End Sub

 

[kelly mort]

No solution when I started working on this, so I'll add mine anyhow; (I assume column B has always got a value in, this should keep the range dynamic)

Option Explicit

Sub a1084411()
'https://www.mrexcel.com/forum/excel-questions/1084411-delete-cell-contents-if-not-todays-date-adjacent-cells.html
Dim r As Integer, c As Integer, LRow As Long


Application.ScreenUpdating = False


LRow = Cells(Rows.Count, "B").End(xlUp).Row


For c = 6 To 14 Step 2
    For r = LRow To 5 Step -1
        If Cells(r, c).Value <> Date Then Range(Cells(r, c - 1), Cells(r, c)).ClearContents
    Next r
Next c


Application.ScreenUpdating = True


End Sub

Cool this works for me.

Thanks

 

[kelly mort]

If I misunderstood that, so you meant you want to apply the code to all the columns with dates in them ( columns F, H, J, L and N), then:

Sub ClearNotTodayV2()
 Dim k As Long
 Application.ScreenUpdating = False
  For k = 5 To 13 Step 2
   With ActiveSheet
    .AutoFilterMode = False
    .[B4:N4].AutoFilter k, "<>" & CLng(Date)
    .Cells(5, k).Resize(1000, 2).Value = ""
    .AutoFilterMode = False
   End With
  Next k
 Application.ScreenUpdating = True
End Sub

It's deleting everything when I change the line

.cells(5, k)

To

.cells (4, k)

 

[MARK858]

Kelly, what happens with the below?

Sub ClearNotTodayV2()
 Dim k As Long
 Application.ScreenUpdating = False
  k = 4
   With ActiveSheet
    .AutoFilterMode = False
    .[B3:N3].AutoFilter 5, "<>" & CLng(Date)
    .Cells(4, k).Resize(1000, 2).Value = ""
    .AutoFilterMode = False
   End With
 Application.ScreenUpdating = True
End Sub

or

Sub ClearNotTodayV2()
    Dim k As Long
    Application.ScreenUpdating = False
    k = 4
    With ActiveSheet
        .AutoFilterMode = False
        .[B3:N3].AutoFilter 5, "<>" & CLng(Date)
        .Cells(4, k).Resize(1000, 2).SpecialCells(12).Value = ""
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

 

[kelly mort]

Kelly, what happens with the below?

Sub ClearNotTodayV2()
 Dim k As Long
 Application.ScreenUpdating = False
  k = 4
   With ActiveSheet
    .AutoFilterMode = False
    .[B3:N3].AutoFilter 5, "<>" & CLng(Date)
    .Cells(4, k).Resize(1000, 2).Value = ""
    .AutoFilterMode = False
   End With
 Application.ScreenUpdating = True
End Sub

or

Sub ClearNotTodayV2()
    Dim k As Long
    Application.ScreenUpdating = False
    k = 4
    With ActiveSheet
        .AutoFilterMode = False
        .[B3:N3].AutoFilter 5, "<>" & CLng(Date)
        .Cells(4, k).Resize(1000, 2).SpecialCells(12).Value = ""
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

This one is not deleting anything at all.

 

[kelly mort]

No solution when I started working on this, so I'll add mine anyhow; (I assume column B has always got a value in, this should keep the range dynamic)

Option Explicit

Sub a1084411()
'https://www.mrexcel.com/forum/excel-questions/1084411-delete-cell-contents-if-not-todays-date-adjacent-cells.html
Dim r As Integer, c As Integer, LRow As Long


Application.ScreenUpdating = False


LRow = Cells(Rows.Count, "B").End(xlUp).Row


For c = 6 To 14 Step 2
    For r = LRow To 5 Step -1
        If Cells(r, c).Value <> Date Then Range(Cells(r, c - 1), Cells(r, c)).ClearContents
    Next r
Next c


Application.ScreenUpdating = True


End Sub

How do I change the date to take a range of dates?

The dates will be located in two cells say C2 and D2 .

So we delete dates that are not in that range from C2 to D2?

 

[MARK858]

This one is not deleting anything at all.

Strange, as it does for me if your dates are in column F. The only issue for me was K needed to be 5 as it was clearing columns D and E rather than E and F.

Sub ClearNotTodayV2()
    Dim k As Long
    Application.ScreenUpdating = False
    k = [COLOR="#FF0000"]5[/COLOR]
    With ActiveSheet
        .AutoFilterMode = False
        .[B3:N3].AutoFilter 5, "<>" & CLng(Date)
        .Cells(4, k).Resize(1000, 2).Value = ""
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

What does the formula

=ISNUMBER(F6)

give you?