VBA Code problem (Takes to long to run)

frets · Apr 10, 2013

I have this VBA code that is taking about 20 minutes to run through 100K rows in a excel sheet. The code is to look for the word "M13" and when it finds it, it's to delete the whole row of data.

Is there a way to speed up this process? The code listed below:

<colgroup><col style="width:48pt" width="64"> </colgroup><tbody>

Sub Delete_Based_on_Remove_M13 ()

' This macro will delete an entire row based on the presence of a

'predefined word or set of words. If that word or set of words is

'found in a cell, in a specified column, the entire row will be 'deleted

Dim X As Long

Dim Z As Long

Dim LastRow As Long

Dim FoundRowToDelete As Boolean

Dim OriginalCalculationMode As Long

Dim RowsToDelete As Range

Dim SearchItems() As String

Dim DataStartRow As Long

Dim SearchColumn As String

Dim SheetName As String

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Choose the row you want the search and delete to start on

' Choose the column to search and delete to use for deletion

' Choose the sheet in the workbook you want this macro to be run on

DataStartRow = 1

SearchColumn = "C"

SheetName = "Sheet1"

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Enter the terms you want to be used for criteria for deletion

' All terms entered below are CASE SENSITIVE and need to be

'seperated by a comma

SearchItems = Split("M13")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

On Error GoTo Whoops

OriginalCalculationMode = Application.Calculation

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

With Worksheets(SheetName)

LastRow = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row

For X = LastRow To DataStartRow Step -1

FoundRowToDelete = False

For Z = 0 To UBound(SearchItems)

If InStr(.Cells(X, SearchColumn).Value, SearchItems(Z)) Then

FoundRowToDelete = True

Exit For

End If

If RowsToDelete Is Nothing Then

Set RowsToDelete = .Cells(X, SearchColumn)

Else

Set RowsToDelete = Union(RowsToDelete, .Cells(X, SearchColumn))

End If

If RowsToDelete.Areas.Count > 100 Then

RowsToDelete.EntireRow.Delete

Set RowsToDelete = Nothing

End If

If Not RowsToDelete Is Nothing Then

RowsToDelete.EntireRow.Delete

End If

Whoops:

Application.Calculation = OriginalCalculationMode

Application.ScreenUpdating = True

End Sub

</tbody>

hiker95 · Apr 10, 2013

frets,

The code is to look for the word "M13" and when it finds it, it's to delete the whole row of data.

What column contains the word M13?

Is M13 part of a longer string?

Is there a way to speed up this process? The code listed below:

There is no code posted.

If posting VBA code, please use Code Tags - like this:

[code]

'Paste your code here.

[/code]

frets · Apr 10, 2013

Rich (BB code):

  
   Sub Delete_Based_on_Remove_M13 ()
   
   ' This macro will delete an entire row based on the presence of   a
   
   'predefined word or set of words.  If that word or set of words is
   
   'found in a cell, in a specified column, the entire row will be   'deleted
   
   Dim X As Long
   
   Dim Z As Long
   
   Dim LastRow As Long
   
   Dim FoundRowToDelete As Boolean
   
   Dim OriginalCalculationMode As Long
   
   Dim RowsToDelete As Range
   
   Dim SearchItems() As String
   
   Dim DataStartRow As Long
   
   Dim SearchColumn As String
   
   Dim SheetName As String
   
    
   
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   ' Choose the row you want the search and delete to start on
   
   ' Choose the column to search and delete to use for deletion
   
   ' Choose the sheet in the workbook you want this macro to be run   on
   
   DataStartRow = 1
   
   SearchColumn = "C"
   
   SheetName = "Sheet1"
   
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    
   
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   ' Enter the terms you want to be used for criteria for deletion
   
   ' All terms entered below are CASE SENSITIVE and need to be
   
   'seperated by a comma
   
   SearchItems = Split("M13")
   
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    
   
   On Error GoTo Whoops
   
   OriginalCalculationMode = Application.Calculation
   
   Application.Calculation = xlCalculationManual
   
   Application.ScreenUpdating = False
   
   With Worksheets(SheetName)
   
   LastRow = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row
   
   For X = LastRow To DataStartRow Step -1
   
   FoundRowToDelete = False
   
   For Z = 0 To UBound(SearchItems)
   
   If InStr(.Cells(X, SearchColumn).Value, SearchItems(Z)) Then
   
   FoundRowToDelete = True
   
   Exit For
   
   End If
   
   Next
   
   If FoundRowToDelete Then
   
   If RowsToDelete Is Nothing Then
   
   Set RowsToDelete = .Cells(X, SearchColumn)
   
   Else
   
   Set RowsToDelete = Union(RowsToDelete, .Cells(X, SearchColumn))
   
   End If
   
   If RowsToDelete.Areas.Count > 100 Then
   
   RowsToDelete.EntireRow.Delete
   
   Set RowsToDelete = Nothing
   
   End If
   
   End If
   
   Next
   
   End With
   
   If Not RowsToDelete Is Nothing Then
   
   RowsToDelete.EntireRow.Delete
   
   End If
   
   Whoops:
   
   Application.Calculation = OriginalCalculationMode
   
   Application.ScreenUpdating = True
   
    
   
   End Sub
   

  <tbody>

 </tbody>

Jonmo1 · Apr 10, 2013

I see you turn Calculation and ScreenUpdating off
You can also turn off Events, which should help a bit as well.

Application.EnableEvents = False

And set back to true at the end
Application.EnableEvents = True

frets · Apr 10, 2013

Thanks

Is there a more simple code that will do the same?

hiker95 · Apr 10, 2013

frets,

Sample raw data:

Excel 2007

C

1

2

3

4

M13,Test,Test2

5

6

7

8

Test,M13,Test2

9

10

11

12

13

14

Test,Test2,M13

15

16

17

18

Sheet1

After the macro - execution time 0.000 seconds:

Excel 2007

C

1

2

3

4

5

6

7

9

8

10

9

11

10

12

11

13

12

15

13

16

14

17

15

16

17

18

Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:

Option Explicit
Sub DeleteRowsColumnC_M13()
' hiker95, 04/10/2013
' http://www.mrexcel.com/forum/excel-questions/696195-visual-basic-applications-code-problem-takes-long-run.html
Dim r As Long, lr As Long
Dim OriginalCalculationMode As Long
OriginalCalculationMode = Application.Calculation
With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  .EnableEvents = False
  With Sheets("Sheet1")
    lr = .Cells(Rows.Count, "C").End(xlUp).Row
    For r = lr To 1 Step -1
      If InStr(.Cells(r, "C"), "M13") > 0 Then .Rows(r).Delete
    Next r
  End With
  .EnableEvents = True
  .Calculation = OriginalCalculationMode
  .ScreenUpdating = True
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the DeleteRowsColumnC_M13 macro.

hiker95 · Apr 10, 2013

frets,

I could re-write the macro using two arrays in memory that could be a lot faster then my last reply.

What is the normal/max last row in Sheet1?

What is the last used column in Sheet1?

frets · Apr 10, 2013

Thanks works fine

hiker95 · Apr 10, 2013

frets,

You are very welcome. Glad I could help.

Thanks for the feedback.

Come back anytime.

VBA Code problem (Takes to long to run)

frets

New Member

Excel Facts

hiker95

Well-known Member

frets

New Member

Jonmo1

MrExcel MVP

frets

New Member

hiker95

Well-known Member

hiker95

Well-known Member

frets

New Member

hiker95

Well-known Member

Forum statistics

Share this page

VBA Code problem (Takes to long to run)

New Member

Excel Facts

Well-known Member

New Member

MrExcel MVP

New Member

Well-known Member

Well-known Member

New Member

Well-known Member

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock