title: Execution of VBA code gets slow after many iterations
body: <p>I have written a little sub to filter approx. 56.000 items in an Excel List.</p>
  
  <p>It works as expected, but it gets really slower and slower after like 30.000 Iterations. After 100.000 Iterations it's really slow...</p>
  
  <p>The Sub checks each row, if it contains any of the defined words (KeyWords Array). If true, it checks if it is a false positive and afterwards deletes it.</p>
  
  <p>What am I missing here? Why does it get so slow?</p>
  
  <p>Thanks...</p>
  
  <pre><code>Private Sub removeAllOthers()
  '
  ' removes all Rows where Name does not contain
  ' LTG, Leitung...
  '
  
  Application.ScreenUpdating = False    
  Dim TotalRows As Long
  TotalRows = Cells(rows.Count, 4).End(xlUp).row
  
  ' Define all words with meaning "Leitung"
  KeyWords = Array("LTG", "LEITUNG", "LETG", "LEITG", "MASSE")
  
  ' Define all words which are false positives"
  BadWords = Array("DUMMY", "BEF", "HALTER", "VORSCHALTGERAET", _
                   "VORLAUFLEITUNG", "ANLEITUNG", "ABSCHIRMUNG", _
                   "AUSGLEICHSLEITUNG", "ABDECKUNG", "KAELTEMITTELLEITUNG", _
                   "LOESCHMITTELLEITUNG", "ROHRLEITUNG", "VERKLEIDUNG", _
                   "UNTERDRUCK", "ENTLUEFTUNGSLEITUNG", "KRAFTSTOFFLEITUNG", _
                   "KST", "AUSPUFF", "BREMSLEITUNG", "HYDRAULIKLEITUNG", _
                   "KUEHLLEITUNG", "LUFTLEITUNG", "DRUCKLEITUNG", "HEIZUNGSLEITUNG", _
                   "OELLEITUNG", "RUECKLAUFLEITUNG", "HALTESCHIENE", _
                   "SCHLAUCHLEITUNG", "LUFTMASSE", "KLEBEMASSE", "DICHTUNGSMASSE")
  
  For i = TotalRows To MIN_ROW Step -1
  
      Dim nmbr As Long
      nmbr = TotalRows - i
  
      If nmbr Mod 20 = 0 Then
          Application.StatusBar = "Progress: " &amp; nmbr &amp; " of " &amp; TotalRows - MIN_ROW &amp; ": " &amp; Format(nmbr / (TotalRows - MIN_ROW), "Percent")
      End If
  
      Set C = Range(NAME_COLUMN &amp; i)
  
      Dim Val As Variant
      Val = C.Value
  
      Dim found As Boolean
  
      For Each keyw In KeyWords
          found = InStr(1, Val, keyw) &lt;&gt; 0
          If (found) Then
              Exit For
          End If
      Next
  
      ' Check if LTG contains Bad Word
      Dim badWord As Boolean
  
      If found Then
  
          'Necessary because SCHALTER contains HALTER
          If InStr(1, Val, "SCHALTER") = 0 Then
              'Bad Word filter
              For Each badw In BadWords
                  badWord = InStr(1, Val, badw) &lt;&gt; 0
                  If badWord Then
                      Exit For
                  End If
              Next
  
          End If
      End If
  
      If found = False Or badWord = True Then
          C.EntireRow.Delete
      End If
  
  Next i
  
  Application.StatusBar = False
  
  Application.ScreenUpdating = True
  
  End Sub
  </code></pre>