VBA code required to delete rows with future dates - Urgent

[exceluser9]

Hi Team,

I have a data column J and K with formula =IFERROR(IF(G3<>"",WORKDAY(G3,3),""),"") in column J and =IFERROR(IF(H3<>"",WORKDAY(J3,2),""),"") in column K.

I need a vba code to delete the entire row if column "J" has future date, it should retain current date and past date.

And it should also delete entire row if column "K" has a future date (Retain if it has todays date & past date) only if column "H" contains today's date or past date.

If column J & K is blank please retain record.

Column G	Column H		Column J	Column K
06-08-2019	08-08-2019		09/08/2019	13/08/2019
05-08-2019	07-08-2019		08/08/2019	12/08/2019
07-08-2019			12/08/2019
07-08-2019			12/08/2019
07-08-2019			12/08/2019
07-08-2019			12/08/2019
07-08-2019			12/08/2019
07-08-2019			12/08/2019
07-08-2019			12/08/2019
07-08-2019			12/08/2019
07-08-2019			12/08/2019
07-08-2019			12/08/2019

<colgroup><col><col span="2"><col span="2"></colgroup><tbody>
</tbody>

 

[Fluff]

What is the point of worrying about column K if the first part does not work?
You say that this is Urgent, but you continually fail to answer my questions.

 

[exceluser9]

I already answered your questions.
Your code doesn't filter column J

 

[Fluff]

Please read post#17, you have not answered that question. Nor seemingly taken onboard what I said about not being able to see your screen and thus needing you to give me the information I need in order to help you.

 

[exceluser9]

This code unfilters everything and nothing happens. It doesnt filter column J for future date

Sub exceluser9()
With Sheets("Delete")
.Range("$A$1:$K$10000").AutoFilter 10, ">" & CLng(Date)
End With
End Sub

 

[exceluser9]

Hi Fluff,

Im using this code it works fine but it deletes blank cells as well, could you amend to skip blank?

Sub DeleteRowBasedOnDateRange()


Dim spem As Workbook
Dim ws As Worksheet
Dim N As Long, I As Long


Set spem = Excel.Workbooks("Testing VBA.xlsm")
Set ws = spem.Worksheets("Sheet1")


N = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row


For I = N To 2 Step -1
If ws.Cells(I, "K").Value > Date Then
ws.Rows(I).Delete
End If
Next I


End Sub

 

[Fluff]

Try

If ws.Cells(i, "K").Value > Date And ws.Cells(i, "K") <> "" Then

 

[exceluser9]

Thanks Fluff.

Also users will save the sheet as per their preference.

Do we have to change below code as well?

Set spem = Excel.Workbooks("Testing VBA.xlsm")

 

[Fluff]

If the code is in that workbook then change it to

Sub DeleteRowBasedOnDateRange()
Dim ws As Worksheet
Dim N As Long, I As Long


Set ws = ThisWorkbook.Worksheets("Sheet1")


N = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row


For I = N To 2 Step -1

 

[exceluser9]

Hi Fluff,

Im using below code and nothing happens. Its not deleting rows

Sub DeleteRowBasedOnDateRange()


Dim ws As Worksheet
Dim N As Long, I As Long




Set ws = ThisWorkbook.Worksheets("Sheet1")


N = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row




For I = N To 2 Step -1
If ws.Cells(i, "K").Value > Date And ws.Cells(i, "K") <> "" Then
ws.Rows(I).Delete
End If
Next I




End Sub

 

[Fluff]

Is the code in the same workbook as the sheet where you want to delete the rows?