VBA/MACRO to delete rows based on date

[ldashev]

I'd like to create a macro to delete rows based on a date (let's say all dates prior to 1/1/2016) from a file. The date field is column B. Could someone please help put together the code? Below is a sample data set

Col1	Col2	Col3	Col4
1	2-Jan-14	ABC	782350
2	2-Jan-14	ABC	782230
3	9-Jan-15	ABC	792270
4	9-Jan-15	ABC	791539
5	2-Jan-15	ABC	782349
6	2-Jan-14	BCD	782230
7	9-Jan-15	BCD	792270
8	9-Jan-15	BCD	791539
9	2-Jan-15	XYZ	782349
10	9-Jan-15	XYZ	792306
11	9-Jan-15	XYZ	791550
12	2-Jan-15	XYZ	783079
13	9-Jan-15	XYZ	791648
14	9-Jan-15	XYZ	792286
15	2-Jan-15	XYZ	782994
16	1-Mar-16	XYZ	792273
17	1-Mar-16	XYZ	791657
18	1-Mar-16	XYZ	791671
19	1-Mar-16	XYZ	782208
20	1-Mar-16	XYZ	792262
21	1-Mar-16	XYZ	790996
22	1-Mar-16	XYZ	793205

<tbody>
</tbody>

 

[Joe4]

Is your data always going to be sorted chronologically?
If not, is it all right to have our VBA code re-order the data in this way?

Where is this "date" coming from?
Is it user input, or coming from some cell?

 

[texasalynn]

try this

Sub DeleteFromDate()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim LR As Long
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
DateR = Application.InputBox("Enter based on date to delete", TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1)
Cells.AutoFilter Field:=2, Criteria1:=">=" & DateR
ALR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If ALR > 2 Then
    Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).Select
    Range("A2:A" & LR).Delete
    Range("A1").Activate
End If
Cells.AutoFilter
MsgBox "Finished deleting rows"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[ldashev]

It works...just needed to change the > to <. Thank you

try this

Sub DeleteFromDate()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim LR As Long
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
DateR = Application.InputBox("Enter based on date to delete", TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1)
Cells.AutoFilter Field:=2, Criteria1:=">=" & DateR
ALR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If ALR > 2 Then
    Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).Select
    Range("A2:A" & LR).Delete
    Range("A1").Activate
End If
Cells.AutoFilter
MsgBox "Finished deleting rows"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[rajash]

Hi, similar to the issue above I have pasted set of data (this is only a sample) from which I require the user to be able to select via a message box a date range( col G).Rows outside of this range deleted. This should be look at the last row with data in the worksheet and loop from bottom to top. The headers are in row 2.

Any help would be appreciated.

Site	Project Code	Status	Client Name	Project Name	PJM	Active	Budget Date
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	20-Jan-2015
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	10-Feb-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	28-Feb-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	28-Feb-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	10-Jan-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	28-Feb-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	31-Jul-2016
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	20-Jan-2015
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	31-Jul-2016
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	31-Jan-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	28-Feb-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	10-Feb-2016
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	31-Jul-2016
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	31-Jul-2016
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	28-Feb-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	28-Feb-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	31-Jul-2016
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	20-Oct-2016
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	31-Jul-2016
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	10-Jan-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	28-Feb-2017
xxxxxx	xxxxxx	In Progress	xxxxx	xxxxx	xxxxx	TRUE	31-Jan-2017

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

Thanks

 

[texasalynn]

would be best to create a new post so that you will get better visibility

 

[rajash]

would be best to create a new post so that you will get better visibility

Will do. Thanks Texaslynn