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>

 

[exceluser9]

Yes same workbook.


Below code works absolutely but only change i require is it should accept any workbook name.

Sub DeleteRowBasedOnDateRange()


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


Set spem = Excel.Workbooks("Tes.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




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


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


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


End Sub

 

[Fluff]

If the code exists in the same workbook as the rows being deleted, then you don't need the name of the workbook, you can just use ThisWorkbook.
If the code is in a different workbook then you could use ActiveWorkbook, but that can be dangerous if the wrong workbook is active when you run the code.

If you don't want to use either of those options, how would you decide what the workbook name is?

 

[exceluser9]

The code should work even if user changes the workbook name. Currently its is Tes and it should work even if workbook name is changed to Test

 

[exceluser9]

Hi Fluff,

Below code works fine but can the deletion happen from row 3?

Sub DeleteRowBasedOnDateRange()


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


Set spem = Excel.Workbooks("Tes.xlsm")
Set ws = spem.Worksheets("Test")


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


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




Set spem = Excel.Workbooks("Tes.xlsm")
Set ws = spem.Worksheets("Test")


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]

Is the code in the Tes.xlsm workbook?

 

[exceluser9]

Yes it is and later the name could change

 

[Fluff]

In that case you can use

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


Set ws = ThisWorkbook.Worksheets("Test")


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


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

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

 

[exceluser9]

Thank you so much Fluff

 

[Fluff]

You're welcome