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]

Try:

Sub upload()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    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
    Application.CutCopyMode = False
    Sheets("Data").Range("A1:C" & LastRow).Select
    Sheets("Data").Sort.SortFields.Clear
    Sheets("Data").Sort.SortFields.Add Key:=Range("C2:C" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With Sheets("Data").Sort
        .SetRange Range("A1:C" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Sub

If you have columns beyond column C, you will have to change the "C" in the sorting section of the code to your last used column letter starting at this line:

Sheets("Data").Range("A1:C" & LastRow).Select

 

[papare]

momps, thanks legend...

 

[mumps]

Glad to help.

 

[papare]

Sub upload()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets("Input").Range("C2,C3,C4,C5,C7").Copy
Sheets("Data").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
Sheets("Input").Range("C2:C9").ClearContents
Application.CutCopyMode = False
Sheets("Data").Range("C2:G" & LastRow).Select
Sheets("Data").Sort.SortFields.Clear
Sheets("Data").Sort.SortFields.Add Key:=Range("C2:C" & LastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets("Data").Sort
.SetRange Range("C1:G" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub


Hi Mumps,

The code keeps breaking on the
Sheets("Data").Range("C2:G" & LastRow).Select

I dont understand the solution.

Kindly assist.

 

[mumps]

I think that it would be much easier to follow if I could see how your data is organized. Perhaps you could upload a copy of your file to a free site such as www.box.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[papare]

Hi Mumps,

Thanks for your quick reply. Please find the link https://app.box.com/s/994pt6d3p4gaxh1jreql
Note Input sheet : I use to input data, which is save on the DATA sheet. The summary sheet gives the data requested defined by acc nr, and date ranges. Another issue i have is that I have formulas in the sheets which are slowing down the performance of the spreadsheet. many Thanks in Advance

 

[mumps]

Hi papare. Try this macro:

Sub upload()
    Application.ScreenUpdating = False
    Dim bottomG As Long
    bottomG = Sheets("Data").Range("G" & Rows.Count).End(xlUp).Row
    Sheets("Input").Range("C2,C3,C4,C5,C7").Copy
    Sheets("Data").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
    Paste:=xlPasteValues, Transpose:=True
    Sheets("Input").Range("C2:C9").ClearContents
    Application.CutCopyMode = False
    Sheets("Data").Range("C2:G" & bottomG).Select
    Sheets("Data").Sort.SortFields.Clear
    Sheets("Data").Sort.SortFields.Add Key:=Range("C2:C" & bottomG), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets("Data").Sort
        .SetRange Range("C1:G" & bottomG)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Sub

 

[papare]

Hi Mumps,

Thanks for the quick reply. Still the same problem. its only sorts the data when Sheet (Data) is activate automatically.
Many Thanks

 

[mumps]

Try deleting this line:

Sheets("Data").Range("C2:G" & bottomG).Select