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?

 

[Boller]

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?

A better/faster approach is to use a filter as suggested by xld.

However, with 20,000 rows of data, if there are a lot of non-contiguous rows to be deleted, an even faster method than using a filter is likely to be :

- use a helper column with a worksheet formula to identify the rows to be deleted

- sort by the helper column so that that rows to be deleted are grouped together at the bottom (this will keep the data to be retained in its original sequence)

- via SpecialCells, delete the rows

- delete the helper column

 

[PoggiPJ]

You don't need a lopp to check if that value is in the array, just use

            ThisPartIsNotInTheContract = IsError(Application.Match(RefTableRange.Cells(RefTableRow, 1), PAPartArray, 0))

But a filter is the fastest way to delete data.

XLD, replacing the loop with your one statement has reduced the processing time to build the delete list to less than one minute!

 

[Blade Hunter]

XLD, replacing the loop with your one statement has reduced the processing time to build the delete list to less than one minute!

Looking through the code, I can't see where RefTableRange is being defined.

Maybe just change your delete statement to Range(DelRows).Delete

 

[PoggiPJ]

Looking through the code, I can't see where RefTableRange is being defined.

The range is defined as an argument to the subroutine.

Private Sub CompressReferenceTable(ByRef RefTableRange As Range)

This is beginning to make me nuts. Everything falls into place except the final delete statement.

 

[Blade Hunter]

Driving me nuts because when I manually build a string and run the delete code it works .

 

[Blade Hunter]

Can you change to the sheet. I think there may be something about deleting rows on a sheet you don't have selected but I can't quite remember.

 

[PoggiPJ]

No, I already had it as the active sheet. Even made sure it was unprotected. Ok I'm ready to cry. I have to hold myself together.

 

[ZVI]

Hi,

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

... Ok I'm ready to cry...

Peter, don't cry, baby
Such operation can be done in few seconds, try this code:

Main subroutine:

' ZVI:2009-11-12 http://www.mrexcel.com/forum/showthread.php?t=428654
' Table is the range in which the rows not matched in DicArray() are deleted
Sub CompressTable(Table As Range, DicArray)
  Dim RngToBeDel As Range, x
  With CreateObject("Scripting.Dictionary")
    ' Create dictionary from DicArray()
    .CompareMode = 1
    For Each x In DicArray
      .Item(x) = 0
    Next
    ' Collect rows of Table to be deleted
    For Each x In Table.Cells
      If Not .Exists(x.Value) Then
        If RngToBeDel Is Nothing Then
          Set RngToBeDel = x.EntireRow
        Else
          Set RngToBeDel = Application.Union(RngToBeDel, x.EntireRow)
        End If
      End If
    Next
  End With
  ' Delete collected rows
  If RngToBeDel Is Nothing Then Exit Sub
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    x = .Calculation: .Calculation = xlCalculationManual
    RngToBeDel.Delete
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = x
  End With
End Sub

Calling code:

Sub Test()
  
  Dim Table As Range, PAPartArray()
  
  ' The range of table to be compressed
  Set Table = DSWPrices.Range("DSWPriceRange").Columns(1)
  
  ' Tune next line by your sheet & range, or populate PAPartArray() as required
  PAPartArray() = MySheet.Range("MyRange").Columns(1).Value
  
  ' Delete Table rows not matched in PAPartArray()
  CompressTable Table, PAPartArray()
  
End Sub

Regards,
Vladimir

 

[PoggiPJ]

Hi Vladimir,
Thank you. I have now pulled myself together and I'm ready to solve this problem Well, I can tell you that the string of rows to be deleted WELL exceeds 256. More like 15,000.

 

[PoggiPJ]

Solved

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