Automatic Delete entries with dates that are less than todays

[papare]

I am looking for a logic/macro/vba code that will automatically delete certain entries that are older than todays date.

At the moment I collect data using the below code:
Sub upload()

Sheets("Input").Range("C2,C3,C4,C5,C6,C7,C9").Copy
Sheets("Data").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
Sheets("Input").Range("C2:C9").ClearContents

End Sub

The Column C in DATA (Sheet) is the date, Column D is the description that determines that data to be deleted. At the moment I do it manually but would like for it to be automated.
Logic at the moment: IF(LEFT(D2,2)="CS","",I2)
The logic that I was thinking would be better is and embeded in the macro/code: IF(and (LEFT(D2,2)="CS",C2<today),"",I2).

Kindly assist with the code to be embeded with the above macro/vba code.

 

[mumps]

Just to clarify ... if the first 2 characters in D2 = "CS", then you want cell D2 to be cleared, otherwise you want D2 to be replaced with I2. Is this correct?

 

[papare]

Thanks for your reply.
If the first 2 characters in D2 = "CS", then you want cell I2 to be cleared, otherwise do nothing. But this is only for dates Column C, that are less than todays date.

 

[mumps]

Try:

Sub ClearCell()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("C2:C" & LastRow)
        If rng < Date And Left(rng.Offset(0, 1), 2) = "CS" Then
            Cells(rng.Row, "I").ClearContents
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[papare]

Thanks you are a star, legend

 

[papare]

Hi Mums,
tried to change the code

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
For Each rng In Range("C2:C" & LastRow)
If rng < Date And Left(rng.Offset(0, 1), 2) = "CS" Then
EntireRow.Delete
End If
Next rng
Application.ScreenUpdating = True
End Sub

now just deleting the entire row, but its only deleting one row (e.g. I have 2/3 entries with the first 2 letters "CS", on the same date).

Kindly Assist

 

[mumps]

When deleting entire rows, we have to start at the bottom of your data and work our way up to the top. Try:

Sub DelRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long
    For x = LastRow To 2 Step -1
        If Cells(x, "C") < Date And Left(Cells(x, "D"), 2) = "CS" Then
            Rows(x).EntireRow.Delete
        End If
    Next x
    Application.ScreenUpdating = True
End Sub

 

[papare]

mumps, thanks very much you are a star...

 

[mumps]

My pleasure.

 

[papare]

hi mumps,

on a different query.. using my loading code I want to add a sorting code that will sort the dates. Date (Column C, Sheet (DATA) and range (from A2:A50000). .. Your assistant will be very appreciated... Many Thanks in advance..

Sub upload()

Sheets("Input").Range("C2,C3,C4,C5,C6,C7,C9").Copy
Sheets("Data").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
Sheets("Input").Range("C2:C9").ClearContents

End Sub