Faster Way to Delete Rows?

[PoggiPJ]

My spreadsheet is a contract file that includes a list of part numbers being sold. Each part number refers to a lookup table of ALL about 20,000 valid part numbers and prices. Once the contract is finalized, I want to make the contract sheet smaller by deleting all rows in the lookup table that are not required for this contract.

The following code works, but it takes more than 10 minutes to work through the complete list. I read down the lookup table. For each record in the lookup table, I call a routine that reads through an array of the part numbers that are included in this contract. If the lookup table part number IS included in the contract, I skip it. If it is NOT required, I delete it. I then return to the main lookup table and read in the next lookup table record.

This is the main routine where I progress down the big lookup table.

'Work down the Price File range from top to bottom
    Set RefTableRange = DSWPrices.Range("DSWPriceRange")
    RefTableIndex = 1
    Application.Calculation = xlCalculationManual
    While RefTableIndex < RefTableRange.Rows.Count
        RefTableIndex = RefTableIndex + 1
        'check if this part number is included in the contract
        Call CheckRefTableRow(RefTableRange, RefTableIndex)
    Wend

This is the routine that checks to see if the part is included in the contract.

Private Sub CheckRefTableRow(ByRef RefTableRange As Range, ByRef RefTableRow As Long)
Dim ThisPartIsNotInTheContract As Boolean
Dim x As Long
    
    'assumption that this part will NOT be in the contract and will delete it.
    ThisPartIsNotInTheContract = True
    While ThisPartIsNotInTheContract
        For x = 1 To maxPAParts
            If RefTableRange.Cells(RefTableRow, 1) = PAPartArray(x) Then
                'the part actually IS in the contract
                ThisPartIsNotInTheContract = False
                Exit For
            End If
        Next x
        If ThisPartIsNotInTheContract Then
            'Since this part isn't included in the contract, delete it.
            RefTableRange.Cells(RefTableRow, 1).EntireRow.Delete
            deletedRecordCount = deletedRecordCount + 1
        End If
    Wend
End Sub

I'm wondering if there is a better approach - or if there is a way to select the individual rows to be deleted, and then delete them all at once. Any ideas?

 

[lionpants]

You could try a union. I had a similiar problem with hiding a large amount of rows at once.

Try this...

Dim deleteThis As Range

Set deleteThis = Rows(1)

Do While <whatever>condition
     Set deleteThis = Union(deleteThis, Rows(x))
     x = x + 1
Loop

deleteThis.EntireRow.Delete

This will create a range of rows to be deleted. Every time you find a row you would like to add to be deleted, union it with the existing range (where x is your row).

When you're done building your range of rows, delete it. </whatever>

 

[ZVI]

Re: Solved

Vladimir,
I modified my code to delete in intervals of 25, and it solved the problem. Thank you

Peter, it’s nice to hear that you’ve solved the issue!
And what is the performance time now?

The collecting of each part of addresses in the string with <=255 chars length, with adding range of such part into the union range variable, and after the end of cycling delete all of collected range at ones is the fastest method known for me.

By the way, using of dictionary to check the items presence is faster than other methods for your task.

Vladimir

 

[Blade Hunter]

Hi,

Dan, Range(StringAdresses) faults if length of StringAdresses is more than 255 characters. Seems it’s the case of.

Regards,
Vladimir

Brilliant, thanks for picking up on that, I never would have seen it .

 

[wigi]

How does an advanced filter statement fare? Only 1 statement of VBA required... No loops...

Wigi

 

[Boller]

How does an advanced filter statement fare? Only 1 statement of VBA required... No loops...

Wigi

But can be a bit slow if there are many non-contiguous areas to delete (even tho it is only one line of code).

In such a case, the method I posted can be quicker (it groups together in one area the rows to be deleted).

ZVI's method is likely to be quick.

 

[Legacy 14611]

Some interesting approaches here to an interesting problem.

But hard to test them (e.g. which is fastest) without some specific test data which fairly reflects the OP problem.

Would anyone like to post some test data, or better some code generating this, for a reasonable evaluation of the various suggestions to date, or any others.

 

[Boller]

Here's a start.

Fill A1:A30000 on a blank sheet with "a" in the odd rows and "b" in the even rows.

To delete rows containing "b" (i.e. delete 15000 non-contiguous rows) :-

Application.ScreenUpdating = False
[B1:B30000].FormulaR1C1 = "=IF(RC[-1]=""b"",""d"",1)"
Cells.Sort Key1:=[B1], Order1:=xlAscending, Header:=xlNo
Columns(2).SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
Columns(2).Delete
Application.ScreenUpdating = True

I haven't timed it but it takes a fraction of a second.

Based on this test data, perhaps someone could compare the run time with the other suggested methods.
I briefly tested the Filter method and it took considerably longer.

It should be borne in mind that there is no absolute fastest method for deleting rows.
The speed of the various methods will depend upon the make-up of the data, etc.

 

[Legacy 14611]

Hi Boller,

Thanks for the positive approach.
For the test data, I guess you had something in mind like

Sub testdata()
Dim n As Long
Cells.ClearContents
n = 30000
With Range("A1").Resize(n, 6)
    .Resize(, 1).Value = "=char(2*int(row()/2)-row()+98)"
    .Resize(, 5).Offset(, 1) = "=Char(Int(Rand() * 10) + 65)"
    .Value = .Value
End With
End Sub

and, running your suggested approach

Sub boller()
Dim t
t = Timer
Application.ScreenUpdating = False
[B1:B30000].FormulaR1C1 = "=IF(RC[-1]=""b"",""d"",1)"
Cells.Sort Key1:=[B1], Order1:=xlAscending, Header:=xlNo
Columns(2).SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
Columns(2).Delete
Application.ScreenUpdating = True
MsgBox "Code took " & Format(Timer - t, "0.000") & " secs."
End Sub

Does this seem about right?

 

[ZVI]

Hi Boller,

You have the sense, but the task is little different – have a look on the 1st post. Approx 20000 of LOOKUP operations are required with searching for each its value in the table of (may be) 10000 items, it’s not so simple & fast as IF functionality you've shown.
In other sheets there can be also a lot of dependent slow formulas referenced to the rows which have to be deleted. It is also unknown whether the additional columns can be allowed, etc.

Regards,
Vladimir

 

[PoggiPJ]

Re: Solved

Peter, it’s nice to hear that you’ve solved the issue!
And what is the performance time now?
Vladimir

How does from the original 12 minutes, down to about 50 seconds sound?
Thanks again