Macro to delete rows based on multiple criteria

[GaryStone10]

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.

 

[VoG]

Try

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]

I haven't tested the following code on a sample of data, so I would suggest taking a copy of your data before running...

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]

Try

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]

Try

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]

try turning off Screenupdating as well. How many rows are you working with?

 

[GaryStone10]

Try

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.

 

[GaryStone10]

try turning off Screenupdating as well. How many rows are you working with?

'Only' around 4,000, with around half of those being within the range for deletion.

 

[VoG]

This might speed it up a bit:

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]

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.