Macro to delete rows based on multiple criteria

GaryStone10

Board Regular
Joined
Nov 18, 2008
Messages
100
Hi All

I need a macro to delete old data from a large selection of data, in order to keep the size down.

What I want this macro to do is
Check all rows from 5 downwards.
If A5 (date) is less than cell $B$1 AND B5 is not equal to C5 then delete the whole row.

Continue until reaching the bottom.

Can someone please suggest a macro or point me in the direction of a good tutorial.

Thanks in advance
Gary.
 

Some videos you may like

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Try

Code:
Sub DelBl()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).row
For i = LR To 5 Step -1
    If Range("A" & i).Value < Range("B1").Value And Range("B" & i).Value <> Range("C" & i).Value Then Rows(i).Delete
Next i
End Sub
 

njimack

Well-known Member
Joined
Jun 17, 2005
Messages
7,764
I haven't tested the following code on a sample of data, so I would suggest taking a copy of your data before running...


Code:
Sub Delete_Old_Data()
Dim End_Row As Long
Dim i As Long

End_Row = Range("A" & Rows.Count).End(xlUp).Row

For i = End_Row To 5 Step -1
    If Cells(i, 5) < Range("B1") And Cells(2, 5) > Cells(3, 5) Then Cells(i, 5).EntireRow.Delete
Next i

End Sub
 

GaryStone10

Board Regular
Joined
Nov 18, 2008
Messages
100
Try

Code:
Sub DelBl()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).row
For i = LR To 5 Step -1
    If Range("A" & i).Value < Range("B1").Value And Range("B" & i).Value <> Range("C" & i).Value Then Rows(i).Delete
Next i
End Sub

I'm just running this now.
It's very very slow, even with calculation switched to manual
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650

ADVERTISEMENT

Try

Code:
Sub DelBl()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).row
For i = LR To 5 Step -1
    If Range("A" & i).Value < Range("B1").Value And Range("B" & i).Value <> Range("C" & i).Value Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub
 

sous2817

Well-known Member
Joined
Feb 22, 2008
Messages
2,276
try turning off Screenupdating as well. How many rows are you working with?
 

GaryStone10

Board Regular
Joined
Nov 18, 2008
Messages
100

ADVERTISEMENT

Try

Code:
Sub DelBl()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).row
For i = LR To 5 Step -1
    If Range("A" & i).Value < Range("B1").Value And Range("B" & i).Value <> Range("C" & i).Value Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub

That seems to be working, but taknig a long time still.
Going forward it should only ever have to delete one or 2 days worth of data, so it shouldn't be too bad to use every day.
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
This might speed it up a bit:

Code:
Sub DelBl()
Dim LR As Long, i As Long, x As Variant
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = Range("B1").Value
LR = Range("A" & Rows.Count).End(xlUp).row
For i = LR To 5 Step -1
    If Range("A" & i).Value < x And Range("B" & i).Value <> Range("C" & i).Value Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 

sous2817

Well-known Member
Joined
Feb 22, 2008
Messages
2,276
The only other thing I can think of, which would be faster but probably more of a pain to set up than it's worth, is to sort the data so that all of your rows that need to be deleted are grouped together, and then delete the whole section at once.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,108
Messages
5,599,767
Members
414,336
Latest member
Nicolas2465

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
Top