VBA to delete row based on cell value.

semidevilz

New Member
Joined
Dec 11, 2015
Messages
12
I found a vba script that works in deleting row based on cell value, but I would like help with
1. understanding it
2. make it run faster

I have a spreadsheet that has Dates in Column C. Every week, before I run my report, I delete all my data from the most recent 90 days. Cell "J2" is the "cut off date" that is automatically calculated. So if J2 = 01/01/2016, the code will delete all rows with dates > 01/01/2016

Sub DeleteRow()
Application.ScreenUpdating = False
Dim LR As Long
For LR = Range("C" & Rows.Count).End(xlUp).Row To 2 Step -1
If Range("C" & LR).Value > Range("J2").Value Then
Rows(LR).EntireRow.Delete
End If
Next LR

Question 1:
I still dont get what Range("C" & Row.count) means. Is it just counting the rows from column C?
What is Row To 2 Step -1?

Question 2:
The code seems to work fine, but my worksheet has almost 1 million rows and when I run it, it just keeps clocking. is there a way to run faster? I haven't had a successful execution yet.

will appreicate any feedback on the question or changes to the code.
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Question 1: The code is looping from the last row determined in column C to the second row in column C. It is doing this one line at a time from the bottom to the top.
Question 2: You may want to add a line of code to turn of automatic calculation. With a million lines of code, it just may take this long. It is a loop and has to look at every line of data. You could upgrade your processors to make it run quicker if you machine will allow this to happen. Or upgrade to faster machine.
 
Upvote 0
There are many ways to write code to do what you want.

Below is one way that should be a bit quicker, but it will still probably take a long time.
You will probably need Excel 2010 or later for the code to work (because of SpecialCells limitation in earlier versions).
If it takes too long then post again.

Code:
Sub DeleteRow()
Dim LR&, dte&
LR = Range("C" & Rows.Count).End(xlUp).Row
dte = DateSerial(Year([J2]), Month([J2]), Day([J2]))
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With
Range("C2").AutoFilter Field:=1, Criteria1:=">" & dte
On Error Resume Next
Range("C3:C" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
ActiveSheet.AutoFilterMode = False
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With
End Sub
 
Upvote 0
Here's another possibility.

If it is OK to sort the data by the dates in column C:
Code:
Sub DeleteRow_SortDates()
Dim LR&, dte&, rng As Range
LR = Cells(Rows.Count, 3).End(xlUp)(2).Row
dte = DateSerial(Year([J2]), Month([J2]), Day([J2]))
Set rng = Range([C3], Cells(LR, 3))
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With
Cells(LR, 3) = dte
rng.EntireRow.Sort Key1:=rng(1), Order1:=xlAscending, Header:=xlNo
Range(Columns(3).Find(dte), Cells(LR, 3)).EntireRow.Delete
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With
End Sub

If it is not OK to sort:
Code:
Sub DeleteRow_NoSort()
Dim LR&, dte&, rng As Range
LR = Cells(Rows.Count, 3).End(xlUp)(2).Row
dte = DateSerial(Year([J2]), Month([J2]), Day([J2]))
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With
[A:A].Insert
[A3] = 1
[A3].AutoFill Destination:=Range([A3], Cells(LR - 1, 1)), Type:=xlFillSeries
Set rng = Range([D3], Cells(LR, 4))
Cells(LR, 4) = dte
rng.EntireRow.Sort Key1:=rng(1), Order1:=xlAscending, Header:=xlNo
Range(rng.Find(dte), Cells(LR, 4)).EntireRow.Delete
rng.EntireRow.Sort Key1:=[A3], Order1:=xlAscending, Header:=xlNo
[A:A].Delete
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With
End Sub
 
Upvote 0
Here's another possibility.

If it is OK to sort the data by the dates in column C:
Code:
Sub DeleteRow_SortDates()
Dim LR&, dte&, rng As Range
LR = Cells(Rows.Count, 3).End(xlUp)(2).Row
dte = DateSerial(Year([J2]), Month([J2]), Day([J2]))
Set rng = Range([C3], Cells(LR, 3))
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With
Cells(LR, 3) = dte
rng.EntireRow.Sort Key1:=rng(1), Order1:=xlAscending, Header:=xlNo
Range(Columns(3).Find(dte), Cells(LR, 3)).EntireRow.Delete
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With
End Sub

If it is not OK to sort:
Code:
Sub DeleteRow_NoSort()
Dim LR&, dte&, rng As Range
LR = Cells(Rows.Count, 3).End(xlUp)(2).Row
dte = DateSerial(Year([J2]), Month([J2]), Day([J2]))
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With
[A:A].Insert
[A3] = 1
[A3].AutoFill Destination:=Range([A3], Cells(LR - 1, 1)), Type:=xlFillSeries
Set rng = Range([D3], Cells(LR, 4))
Cells(LR, 4) = dte
rng.EntireRow.Sort Key1:=rng(1), Order1:=xlAscending, Header:=xlNo
Range(rng.Find(dte), Cells(LR, 4)).EntireRow.Delete
rng.EntireRow.Sort Key1:=[A3], Order1:=xlAscending, Header:=xlNo
[A:A].Delete
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With
End Sub

thanks for the help.
My data is already sorted by date with the most recent dates being on the bottom, So no preference if it sorts or not.

Would it be easier and quicker to write a code that looks at the last "n" number of rows from the bottom? I dont even need to delete the rows. Just deleting the data is fine since I need to replace it.

The code with sorting did give me some errors. Since my data starts at row 5, I changed the C3 to C5. Was that correct because it gave me an application error. If I ran it as is, it gave me the same error, but looks like my data gets shifted up 2 rows to C3.
 
Upvote 0
Just use clearcontents

Code:
Sub MM1()
Application.ScreenUpdating = False
Dim R As Long
For R = Range("C" & Rows.Count).End(xlUp).Row To 5 Step -1
  If Range("C" & R).Value > Range("J2").Value Then
     Rows(R).ClearContents
  End If
Next R
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try this:

Code:
Sub SelectEarlierDates()
Dim LR&, dte#, rng As Range, FR&
LR = Cells(Rows.Count, 3).End(xlUp)(2).Row
dte = DateSerial(Year([J2]), Month([J2]), Day([J2])) + 0.5
Set rng = Range([C5], Cells(LR, 3))
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With
With Cells(LR, 3)
    .NumberFormat = "0"
    .Value = dte
End With
rng.EntireRow.Sort Key1:=rng(1), Order1:=xlAscending, Header:=xlNo
FR = Columns(3).Find(dte).Row
Rows(FR).Delete
Range(Cells(FR, 3), Cells(LR - 1, 3)).Select
MsgBox "The earlier dates are in C" & FR & ":C" & LR - 1
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With
End Sub

Did you try the macro in post #3 ?
 
Last edited:
Upvote 0
Just use clearcontents

Code:
Sub MM1()
Application.ScreenUpdating = False
Dim R As Long
For R = Range("C" & Rows.Count).End(xlUp).Row To 5 Step -1
  If Range("C" & R).Value > Range("J2").Value Then
     Rows(R).ClearContents
  End If
Next R
Application.ScreenUpdating = True
End Sub

That is the same as the code the OP posted in his original post, which he said is too slow because he has a million rows.
 
Upvote 0
trying to get something similar.

In my case, I want to:
-check if cell under column F contains a number;
-if not a number, delete the entire row.


How can I do this ?
 
Upvote 0
Try

Code:
Sub MM1()
Dim i As Long
With ActiveSheet
    For i = .Cells(.Cells(.Rows.Count, 6).End(xlUp).Row, 1).Row To 2 Step -1
        If IsNumeric(.Cells(i, 6).Value) = False Then .Cells(i, 6).EntireRow.Delete
    Next i
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,632
Messages
6,120,655
Members
448,975
Latest member
sweeberry

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top