Scan five columns and delete rows that don't have today's date

[kelly mort]

Hi,
I need a script that will scan from E4 to last used row then G4, I4, K4 and M4 for today's date. So any row which does not have today's date in the said columns, delete them.

I am stacked so I need someone pull me out.

Thanks

 

[Peter_SSs]

Not enough information.

1. What if the row has today's date in 1 or more of those columns but not all of them? Does such a row get deleted or kept?

2. Do those columns contain only dates or could the column contain something like "Deadline is 11 September 2018" which does contain today's date (in my time zone at least)

3. Are there headings in row 3?

4. Does the sheet's data start in column A?

5. What is the last column used on the sheet?

 

[kelly mort]

1. Only one column will have today's date and that is enough for delelete
2. Only dates in format "dd-mm-yy"
3. Yes headings are in row 3
4. Yes data starts from col A
5. The last used column is M

Thanks

 

[Peter_SSs]

Sorry, one more: Is it possible that today's date could appear in one of the 'in-between' columns? That is, in H4, J4 or L4?

 

[kelly mort]

No they will only appear in any of the set of columns I mentioned before.

 

[Peter_SSs]

No they will only appear in any of the set of columns I mentioned before.

OK, then assuming that column A can be used to determine the last tow of data, try this in a copy of your workbook.
If you have a very large data set (tens of thousands of rows) with lots of disjoint rows to delete, this may not be the fastest code to use. Post back if that is the case and this takes longer than a moment to complete.

Sub Del_Rows()
  Application.ScreenUpdating = False
  Range("N2").Formula = "=COUNTIF(G4:M4,TODAY())=0"
  With Range("A3:M" & Range("A" & Rows.Count).End(xlUp).Row)
    .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("N1:N2"), Unique:=False
    .Offset(1).EntireRow.Delete
    If .Parent.FilterMode Then .Parent.ShowAllData
  End With
  Range("N2").ClearContents
  Application.ScreenUpdating = True
End Sub

 

[kelly mort]

Okay. Great! !!

It's working faster than I thought

I appreciate your help

 

[kelly mort]

Something just crossed my mind:

Instead of using the today date can I use InputBox to take in the date to filter?

Regards
Kelly

 

[Peter_SSs]

Instead of using the today date can I use InputBox to take in the date to filter?

Try

Sub Del_Rows_v2()
  Dim Resp As String
  
  Resp = InputBox("Enter date of interest")
  If IsDate(Resp) Then
    Application.ScreenUpdating = False
    Range("N2").Formula = "=COUNTIF(G4:M4," & CLng(DateValue(Resp)) & ")=0"
    With Range("A3:M" & Range("A" & Rows.Count).End(xlUp).Row)
      .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("N1:N2"), Unique:=False
      .Offset(1).EntireRow.Delete
      If .Parent.FilterMode Then .Parent.ShowAllData
    End With
    Range("N2").ClearContents
    Application.ScreenUpdating = True
  End If
End Sub

 

[kelly mort]

Okay cool . But this deletes the date in the InputBox. I want to exclude the InputBox date instead.