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]

Rugila

You wrote :-

"Boller thought that it would be difficult to improve on your code. That seemed to me to be bad methodology - reaching conclusions before all the evidence is in. However, as the Roman satirist (was it Juvenal?) mentioned "De gustibus non disputandum", so whatever...!"

Well, I would like to go one step further and state that I don't just think it is difficult to improve on the code - I know it is difficult (and probably not possible).

Your perception of this being "bad methodolgy - reaching conclusions before all the evidence is in" takes no account of experience /knowledge that may exceed your own.

Is your code faster than ZVI's ?

Regarding your question about the author of your inappropriate Latin quote, you appear to be indicating that you can remember the Latin quote but can't remember the author. Hmm .... I don't think so. I bet the web site from which you got this quote also mentions the derivation/author.

"Someone else mentioned using advanced filter for this problem. I wrote a bit of code trying that. Concluded that while advanced filter can be OK for small problems it slows down alarmingly with v. large datasets and other methods are much more appropriate."

I have a vague recollection that I mentioned exactly that problem with Filter.

 

[Legacy 14611]

Hi Boller,

Thanx for input etc.

Well, I would like to go one step further and state that I don't just think it is difficult to improve on the code - I know it is difficult (and probably not possible).
Your perception of this being "bad methodolgy - reaching conclusions before all the evidence is in" takes no account of experience /knowledge that may exceed your own.

Yes, Boller, of course. Belief in ones own omniscience is a common phenomenon.

Is your code faster than ZVI's ?

As a regular contributor to this forum, you presumably have the capability to easily check this yourself. The requisite info is all posted.

Please do so and report back. I and maybe others interested in this thread would likely be interested in your conclusions.

Re Latin quotes. Quite funny really. I didn't get that off a website. Not all info comes from websites. I got it from a pretty reputable author. It was in the a title of some relatively technical (non-website) material. I find the sentiments behind the phrase pretty useful sometimes. There's always Google readily available to both you and I if either of us would like to know any more.

Regards

 

[Boller]

Belief in ones own omniscience is a common phenomenon.

Your admission of such a shortcoming is very commendable.
It's a shame more people do not display this level of humility.

As a regular contributor to this forum, you presumably have the capability to easily check this yourself. The requisite info is all posted.

Please do so and report back. I and maybe others interested in this thread would likely be interested in your conclusions.

Thank you for the invitation/command, but no thanks.
My interest level in this topic is obviously lower than yours.

I got it from a pretty reputable author.

But not reputable enough to know whether or not Juvenal was the author.

 

[ZVI]

Nice idea & code, Rugila!

Yes, on different testing data the different results will be expected.
And I’m sure that both methods can be more improved
But for me it does not worth it because the performance time is less than 1 second for both.

As to comparing the methods it’s my point of view that we should apply testing under the same conditions, i.e. with the same structure of code (both on single Sub because calling means the time consumption) and with staring timer at the same point – before creating variables (in yours it starts not correctly after Dim statement). And it’s clear that any debug information should be excluded.

At these conditions (i.e. after rebuilding mine code in a single Sub with deleting of extra debugging Debug.Print in it, and with starting the timer in your code before Dim statement) on my PC ZVI’s code is a little bit faster. But for me both methods are good enough relative to the originally sounded 10 minutes /50 secs issue.

The testing data code (the same data as in previous version):

' Code of the testing module
Dim a, b
Const n = 20000, m = 40000

Sub New_TestingData()
  a = Empty
  TestingData
End Sub

'Table on Sheet1, Lookup data on Sheet2
Sub TestingData()
  If IsEmpty(a) Then
    Debug.Print "== Prepeare new testing data, please wait...";
    Dim i, j, digz
    ReDim a(1 To n, 1 To 1)
    ReDim b(1 To m, 1 To 12)
    digz = 10 ^ 4
    For i = 1 To n
      a(i, 1) = Int(Rnd * 2 * (m + n)) + 1 + digz
    Next i
    For i = 1 To m: For j = 1 To 12
        If j = 1 Then
          b(i, j) = 2 * Int(Rnd * (m + n)) + 2 + digz
        Else
          b(i, j) = "Xa"
        End If
      Next
    Next
  Else
    Debug.Print "== Restore  old testing data, please wait...";
  End If
  With Sheets("Sheet1").UsedRange
    .Clear
    .Resize(m, 12) = b
  End With
  With Sheets("Sheet2").UsedRange
    .Clear
    .Resize(n, 1) = a
  End With
  Debug.Print " It's ready now =="
End Sub

Start compare code

' Start this sub to compare the methods
Sub Compare_Methods()
  New_TestingData
  CompressTable2
  CodeStuff
End Sub

ZVI’s code

Sub CompressTable2()  ' ZVI
  
  ' Copy the same testing code and start the timer
  Dim t#: TestingData: t = Timer
  
  Dim Arr(), x, key$, r&, i&, Table As Range
  Const NUL As Byte = 0
  
  Set Table = Sheets(1).Range("A1").CurrentRegion
  
  With CreateObject("Scripting.Dictionary")
    ' Create dictionary of Lookup data
    .CompareMode = 1
    Arr() = Sheets(2).Range("A1").CurrentRegion.Columns(1).Value
    For Each x In Arr()
      key = Trim(x)
      If Len(key) > 0 Then .Item(key) = NUL
    Next
    ' Clean values in Table array which are not present in the dictionary
    Arr() = Table.Columns(1).Value
    For r = 1 To UBound(Arr)
      key = Trim(Arr(r, 1))
      If Len(key) > 0 Then
        If Not .Exists(key) Then
          Arr(r, 1) = Empty
        End If
      End If
    Next
  End With
  ' Copy back Arr() values to the Table, Sort & delete rows with Empty cells
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    x = .Calculation: .Calculation = xlCalculationManual
    With Table
      .Columns(1).Value = Arr()
      .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
      i = .Rows.Count - 1
      With .Cells(1, 1)
        If Len(.Value) > 0 Then
          Range(.End(xlDown).Offset(1), .Offset(i)).EntireRow.Delete
        End If
      End With
    End With
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = x
  End With
  
  ' Show the elapsed time
  t = Timer - t:  Debug.Print "ZVI:", Format(t, "0.000") & " secs"
  
End Sub

Rugila’s code

Sub CodeStuff() ' Rugila
    
  ' Copy the same testing code and start the timer
  Dim t#: TestingData: t = Timer
  
  ' Original code
  Dim m As Integer, c(), e, a, z As Object
  Dim i As Long, j As Integer, p As Long
  
  Set z = CreateObject("Scripting.Dictionary")
  z.CompareMode = 1
  For Each e In Sheets("Sheet2").Cells(1).CurrentRegion.Resize(, 1).Value
    z.Item(e) = Empty
  Next
  With Sheets("Sheet1").Cells(1).CurrentRegion
    m = .Columns.Count
    ReDim c(1 To .Rows.Count, 1 To m)
    For Each e In .Resize(, 1).Value
      i = i + 1
      If z.Exists(e) Then
        p = p + 1
        a = .Resize(1, m).Offset(i - 1).Value ' ZVI: .Formula is preferable
        For j = 1 To m
          c(p, j) = a(1, j)
        Next j
      End If
    Next e
    If p > 0 Then
      .ClearContents
      .Resize(p, m) = c
    End If
  End With
  
  ' Show the elapsed time
  t = Timer - t:  Debug.Print "Rugila:", Format(t, "0.000") & " secs"

End Sub

Regards,
Vladimir

P.S. Gentlemen, please be polite. Nothing destroys a newsgroup conversation faster than personal attacks

 

[Boller]

ZVI

P.S. Gentlemen, please be polite. Nothing destroys a newsgroup conversation faster than personal attacks

What prompted you comment? I see nothing in this thread that is impolite or a personal attack.

 

[Legacy 14611]

Hey Vladimir,

I rather like the idea that codes, including speed thereof, should be tested as they are written rather than some other party with an interest in say a speed comparison juggling them for their own purposes, such trying to make their own look better.

However:

ZVI: “As to comparing the methods it’s my point of view that we should apply testing under the same conditions”

Following your own point of view then, when do we see, for testing, your revised code which retains the order of the original data rather than leaving a user spending time (which extra time your existing code doesn’t allow for, but mine does) descrambling your jumbled reordering as best they can?

And when do we see, for testing, your revised code which first checks for possibly extant data at the far side of the worksheet which may vanish without trace with your ”...EntireRow.Delete” procedures? Or should the user take time manually scrolling across to check first, or perhaps use a supplementary code? (extra time taken to do this presumably not included in your code’s timing??)

Yes, codes should fairly be tested under the same conditions. You haven’t done this, you’ve come nowhere near it. Or if you have we’re still awaiting your post confirming this.

Your code is slower Vladimir. Slower by some 15% on the test data you agreed to use. As indicated above it also has other deficiencies. You claim that this result might just be reversed if you impose some additional “equalising” conditions that suit your case, while ignoring others that don’t suit your case.

I suppose in the end that, as noted above ”de gustibus non disputandum (est)” (maybe that was Tacitus). You have to keep yourself happy. Good luck!

Regards, rugila

 

[ZVI]

ZVI
What prompted you comment? I see nothing in this thread that is impolite or a personal attack.

Boller, it’s just for the extrapolated worst case.

My English is not so well, but I would consider that for me the temperature of discussion becomes too hot, and the conversation sometimes goes away from Excel and VBA becoming destructive. I would like to see here more code (especially like Rugila’s one), results of its performance, smiles and LOLs rather than sententious in any forms.

Have you analyzed for example, that you criticize my "etc" saying "would it not be better to detail" (post #37), but at the same time freely use it in your previous post #27 (the latest word)?
In this place I would say "and so on", but remember "etc" I wouldn’t
And just for the case - I’m very sorry for initiating of uproar in this thread, ok?

Best Regards,
Vladimir

 

[ZVI]

Hey Vladimir,

Wow, Rugila!

I suppose in the end that, as noted above ”de gustibus non disputandum (est)” (maybe that was Tacitus).

For regret, I’m not familiar to Latin… Is it the time to answer with some my native Russian words here?

So, comparing an elapsed time with starting of timer into subroutine and after declare variables in your code vs including the calling time and the time for declare variables for mine code is not applicable.
These conditions should be the same to compare the methods, please apply testing data and starting of the timers as it shown in my post #44.

As to your comments:
1. For me sorting of key column is advantage rather than issue. Some searching Excel formulas require the sorted data, for example. Surely my code can be easily modified to retain the original order without an extra time.
2. For me the deleting of entire rows is more corresponds to decreasing of the file size (refer to the goal description in post #1 and to the layout in post #4). But it’s clear that modification of code to delete only table cells is not hard work.

So my rhetorical question: who has declared that those are disadvantages?

But anyway, below is the simplification of my code in which result is retained in original order as you wanted, and cells of the table range are deleted instead of its entire rows, as you wanted too.
You can test it and find that your code is slower of this one approx on 22% (on my PC)

Replace the code of post #44 by this one:

' ZVI: simplified vs the same of post#44
' Original order of the Table is retained
' Only cells of Table are deleted, not Entire Rows
' It is faster vs the same in post#44
Sub CompressTable2()
  
  ' Copy the same testing code and start the timer
  Dim t#: TestingData: t = Timer
  
  ' Main code
  Dim Table As Range, Arr(), x, ac, r&, cs&
  Const NUL As Byte = 0
  With Sheets(1).Range("A1").CurrentRegion
    cs = .Columns.Count + 1
    Set Table = .Resize(, cs)
  End With
  With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    Arr() = Sheets(2).Range("A1").CurrentRegion.Value
    For Each x In Arr()
      .Item(x) = NUL
    Next
    Arr() = Table.Columns(1).Value
    For r = 1 To UBound(Arr)
      If .Exists(Arr(r, 1)) Then Arr(r, 1) = r Else Arr(r, 1) = Empty
    Next
  End With
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    ac = .Calculation: .Calculation = xlCalculationManual
    With Table
      .Columns(cs).Value = Arr()
      .Sort Key1:=.Cells(1, cs), Order1:=xlAscending, Header:=xlNo
      r = UBound(Arr) - 1
      With .Cells(1, cs)
        If Len(.Value) > 0 Then
          Range(.End(xlDown).Offset(1, -cs + 1), .Offset(r)).Delete
        End If
      End With
      .Columns(cs).ClearContents
    End With
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = ac
  End With
  
  ' Show the elapsed time
  t = Timer - t:  Debug.Print "ZVI:", Format(t, "0.000") & " secs"
  
End Sub

You have to keep yourself happy. Good luck!
Regards, rugila

Thank you, I appreciate your powered skills,

Good Luck, my friend (I hope)!
Vladimir

 

[ZVI]

Please apply this code, the previous was not correct release:

' ZVI: simplified vs the same of post#44
' Original order is retained
' Delete only cells of Table vs Entire Rows
' It is faster vs the same in post#44
Sub CompressTable2()
  
  ' Copy the same testing code and start the timer
  Dim t#: TestingData: t = Timer
  
  ' Main code
  Dim Table As Range, Arr(), x, ac, r&, cs&
  Const NUL As Byte = 0
  With Sheets(1).Range("A1").CurrentRegion
    cs = .Columns.Count + 1
    Set Table = .Resize(, cs)
  End With
  With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    Arr() = Sheets(2).Range("A1").CurrentRegion.Value
    For Each x In Arr()
      .Item(x) = NUL
    Next
    Arr() = Table.Columns(1).Value
    For r = 1 To UBound(Arr)
      If .Exists(Arr(r, 1)) Then Arr(r, 1) = r Else Arr(r, 1) = Empty
    Next
  End With
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    ac = .Calculation: .Calculation = xlCalculationManual
    With Table
      .Columns(cs).Value = Arr()
      .Sort Key1:=.Cells(1, cs), Order1:=xlAscending, Header:=xlNo
      r = UBound(Arr) - 1
      With .Cells(1, cs)
        Set x = .End(xlDown).Offset(1, -cs + 1)
        If x.Row <= r Then
          Range(x, .Offset(r)).Delete
        End If
      End With
      .Columns(cs).ClearContents
    End With
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = ac
  End With
  
  ' Show the elapsed time
  t = Timer - t:  Debug.Print "ZVI:", Format(t, "0.000") & " secs"
  
End Sub

 

[Boller]

ZVI

For regret, I’m not familiar to Latin…

Your use of Latin in this thread indicates otherwise.