VBA macro for quick row deletion

Question

I have some really big excel data files, and I need to go through them all and delete all the rows where the cell value in column T is 1. Right now, my code looks like this:

Sub test() Dim cell As Range For Each cell In Worksheets("Sheet1").Range("T5", "T900000") If cell.Value = 1 Then cell.EntireRow.Delete End If Next cell End Sub 

It seems to work, but it runs forever, and I'm going to do it several times. Is there a better way to do this or to somehow optimize what I already have in order to make it work faster?

Answer 1

This does not work the way you think ... When you delete lines as you go through them, you end up skipping the lines. Example: imagine that your rows have numbers 1 ... 10 in column A. You look at the first row and decide to delete it. Now you are looking at the second line. He has number 3! You never looked at line 2!

It would be best to filter the spreadsheet according to your criteria for column T, copy it, paste it into a new worksheet (with formatting, etc.).

You can enable macro photography and do it manually; then you will have the exact VBA code. I am sure it will be much faster.

Even if you don’t, if you want to do for each , where you delete things, reverse the order (start at the end and go back)

Answer 2

If you want to use a loop, the following should not skip elements. I think the @Floris Filter method could be faster.

 Sub Main() Dim Row As Long Dim Sheet As Worksheet Row = 5 Set Sheet = Worksheets("Sheet1") Application.ScreenUpdating = False Do If Sheet.Cells(Row, 20).Value = 1 Then Sheet.Rows(Row).Delete xlShiftUp Else Row = Row + 1 End If Loop While Row <= 900000 Application.ScreenUpdating = True End Sub 

Update I included Application.ScreenUpdating around a loop that usually speeds things up like this!

Answer 3

In case you manage your data as a database and want to delete certain rows from it and you can filter them out, there is a trick to speed up the deletion process. This is very fast, unlike a simple loop:

I am comparing times for different examples (with 4806 lines).

• Standard delete cycle: 2:25
• Deletion Range: 0:20
• Filter Removal: 0:01

Example : I have data in "Tabelle5" and you want to delete certain rows. Data starts at line 6. Each line in column 1 starting with "OLD #" must be deleted.

1) Here is the standard solution (the longest time):

 Dim i As Integer, counter As Integer Dim strToRemove As String, strToRemoveRange As String strToRemove = "OLD#" strToRemoveRange = "" counter = 0 With Tabelle5 For i = .UsedRange.Rows.Count To 6 Step -1 If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then .Rows(i).Delete Shift:=xlUp End If Next i End With 

2) Here is the range decision (average time):

 Dim i As Integer, counter As Integer Dim strToRemove As String, strToRemoveRange As String strToRemove = "OLD#" strToRemoveRange = "" counter = 0 With Tabelle5 For i = .UsedRange.Rows.Count To 6 Step -1 If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then If strToRemoveRange = "" Then strToRemoveRange = CStr(i) & ":" & CStr(i) Else strToRemoveRange = strToRemoveRange & "," & CStr(i) & ":" & CStr(i) End If counter = counter + 1 End If If counter Mod 25 = 0 Then If counter > 0 Then .Range(strToRemoveRange).Delete Shift:=xlUp strToRemoveRange = "" counter = 0 End If End If Next i If Len(strToRemoveRange) > 0 Then '.Range(strToRemoveRange).Delete Shift:=xlUp End If End With 

3) Filter solution (shortest time):

 Dim i As Integer, counter As Integer Dim strToRemove As String, strToRemoveRange As String strToRemove = "OLD#" strToRemoveRange = "" counter = 0 With Tabelle5 For i = .UsedRange.Rows.Count To 6 Step -1 If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then .Cells(i, 1).Interior.Color = RGB(0, 255, 0) counter = counter + 1 End If Next i If counter > 0 Then .Rows("5:5").AutoFilter .AutoFilter.Sort.SortFields.Clear .AutoFilter.Sort.SortFields.Add( _ Range("A5"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255, 0) .AutoFilter.Sort.Header = xlYes .AutoFilter.Sort.MatchCase = False .AutoFilter.Sort.Orientation = xlTopToBottom .AutoFilter.Sort.SortMethod = xlPinYin .AutoFilter.Sort.Apply .Rows("6:" & CStr(counter + 5)).Delete Shift:=xlUp .Rows("5:5").AutoFilter End If End With 

Here the green lines will be ordered from above, and the range of green strokes will be removed altogether. This is the fastest way I know! :-)

I hope this helps someone!

Regards Tom

Answer 4

The fastest method I've found is to clear the string data (.clear) and then sort. For example, I want to get rid of page breaks that appear as "=========="

 I=20 Do While i <= lRow3 If Left(Trim(ws3.Cells(i, 1)), 1) = "=" Then ws3.Range(Rows(i - 7), Rows(i + 2)).Clear 'i = i - 7 'lRow3 = lRow3 - 10 End If i = i + 1 Loop 

Now do the sorting, then do the last line xlUp (ws3.Range ("A1000000"). End (xlUp) .Row) etc.

Removing lines (in one of my files with a size of 220,000 lines) takes 3 minutes. It takes less than 10 seconds to clear the contents.

Then the question arises, how to “delete” empty lines if you need to transfer data below the lines one line above before this is done. :)

Cheers, BJ