Using VBA to evaluate and delete a range of cells

[cheoksoon]

Hi there,

I've got a sample data with a list of dates.

e.g.
A1 = 03/05/2016
A2 = 17/06/2013
A3 = 24/02/2018

There are hundreds of these dates.

I want to create a button which could erase these dates if they are over a certain due date (i.e. 01/01/2017).

How do I do it with VBA?

Thanks!

 

[JoeMo]

This assumes that "over a certain due date" means dates more recent than the due date, and "erase" means clear the date from its cell. Assign this macro to a button.

Sub EraseIfOverdue()
Dim Dte, c As Range
Dte = InputBox("enter due date")
If Not IsDate(CDate(Dte)) Then Exit Sub
Application.ScreenUpdating = False
For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
    If c.Value > CDate(Dte) Then c.ClearContents
Next c
Application.ScreenUpdating = True
End Sub

 

[jim may]

In a standard module.. enter

Sub Foo()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row


For i = LR To 1 Step -1
If Cells(i, 1).Value >= 42736 Then
Cells(i, 1).EntireRow.Delete
End If
Next i


End Sub

 

[My Aswer Is This]

This script means a certain date is greater then.
And this script assumes the dates are in column A
And this script assumes you want to delete the entire row.
This sample script assumes you want to delete any row with date in column A greater then 5/19/18
Look at the script and modify if needed.

Sub Filter_Me_Please()
'Modified 5/19/18 7:15 PM EDT
Dim Lastrow As Long
Dim Lastrowa As Long
Dim c As Long
Dim s As Variant
c = "1" ' Column Number Modify this to your need
s = ">" & "5/19/2018" 'Search Value Modify to your need
Lastrow = Cells(Rows.Count, c).End(xlUp).Row + 1
With ActiveSheet.Cells(1, c).Resize(Lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    MsgBox counter - 1 & "  Rows with   " & s & "  In column  " & c & "  Were found and deleted"
    
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
End Sub

 

[Rick Rothstein]

Your use of "over a certain due date" is kind of confusing. I took the approach that everyone else did, but if that is wrong, simply make the red greater than symbol a less than symbol...

[table="width: 500"]
[tr]
	[td]Sub ClearDates()
  Dim DueDate As Date
  DueDate = DateSerial(2017, 1, 1)
  With Range("A1", Cells(Rows.Count, "A").End(xlUp))
    .Value = Evaluate(Replace("IF(@[B][COLOR="#FF0000"][SIZE=4]>[/SIZE][/COLOR][/B]" & CDbl(DueDate) & ","""",@)", "@", .Address))
  End With
End Sub[/td]
[/tr]
[/table]

 

[cheoksoon]

Wow! Thanks for all the response! I'm spoiled for choice and I certainly didn't expect that.

I've tried all the solutions and they worked perfectly.

I just went with what I thought was the simplest which were the ones proposed by JoeMo and jim may.

I modified it a little so it doesn't delete the entire row because there other important information.

Otherwise, thanks a bunch!