Excel/Altering VBA

Advertisement


Question
QUESTION: Hi Tom

The following is a simple piece of code that deletes every class on one sheet except those listed on a second sheet.

It works in a flash on a file that only contains the two sheets.  However on a much larger file with several sheets, the code executes painfully slowly, the file seems to stall and I have to close it through the task manager.

On further investigation, I went into visual basic and went through each line of the code using the F8 key.  I found that the code deleted lines one by one from the bottom up:

(If Application.CountIf(r2, sh.Cells(i, "s").Value) = 0 Then
   sh.Rows(i).EntireRow.Delete).  

Is there another way of writing the code that might avoid this method?


Sub deleterows()
Dim sh As Worksheet, lastrow As Long, i As Long
Dim sh2 As Worksheet, r2 As Range  ' column A of choose class
Set sh2 = Worksheets("Choose class")
Set r2 = sh2.Columns(1)
Set sh = Worksheets("Sheet2rng")

lastrow = sh.Cells(sh.Rows.Count, "s").End(xlUp).Row
For i = lastrow To 2 Step -1
If Application.CountIf(r2, sh.Cells(i, "s").Value) = 0 Then
   sh.Rows(i).EntireRow.Delete
End If
Next
End Sub


Thanks in advance

Chris

ANSWER: Christopher Mitchell,

one way would be to set calculation to manual at the top of the macro and set it back to automatic at the bottom of the macro.  This assumes that excel is doing a calculation on each row delete.   

Sub deleterows()
Dim sh As Worksheet, lastrow As Long, i As Long
Dim sh2 As Worksheet, r2 As Range  ' column A of choose class
Set sh2 = Worksheets("Choose class")
Set r2 = sh2.Columns(1)
Set sh = Worksheets("Sheet2rng")

lastrow = sh.Cells(sh.Rows.Count, "s").End(xlUp).Row
application.Calculation = xlManual
For i = lastrow To 2 Step -1
If Application.CountIf(r2, sh.Cells(i, "s").Value) = 0 Then
   sh.Rows(i).EntireRow.Delete
End If
Next
application.Calculation = xlAutomatic
End Sub


Or one could build a reference to all the rows to be deleted and issue one command to delete the rows enmasse  at the end of the macro

Sub deleterows()
Dim sh As Worksheet, lastrow As Long, i As Long
Dim sh2 As Worksheet, r2 As Range  ' column A of choose class
Dim r as Range
Set sh2 = Worksheets("Choose class")
Set r2 = sh2.Columns(1)
Set sh = Worksheets("Sheet2rng")

lastrow = sh.Cells(sh.Rows.Count, "s").End(xlUp).Row
For i = lastrow To 2 Step -1
If Application.CountIf(r2, sh.Cells(i, "s").Value) = 0 Then
   if r is nothing then
     set r = sh.cells(i, "s")
   else
     set r = union(r, sh.Cells(i, "s"))
   end if    
End If
Next

if not r is nothing then
 Application.Calculation = xlManual
 r.EntireRow.Delete
 Application.Calculation = xlAutomatic
end if

End Sub

--
Regards,
Tom Ogilvy




---------- FOLLOW-UP ----------

QUESTION: Hi Tom

With the second code I get an error message at line:

"r.EntireRow.Delete"

Have you any idea why this might be?

Chris

Answer
Christopher Mitchell,

Here is a demo from the immediate window:

Set r = Range("S1,S5:S15,S20,S300:S301,S10000")
? r.address
$S$1,$S$5:$S$15,$S$20,$S$300:$S$301,$S$10000
? r.EntireRow.Address
$1:$1,$5:$15,$20:$20,$300:$301,$10000:$10000
r.EntireRow.Delete

r.EntireRow.Delete  worked fine.  

I suspect you might have merged cells.  If you have merged cells, then you might need to remove them.   

Generally a range reference can not refer to more than 8192 non-contiguous areas (not cells - areas).  If you think that you could be building a reference to more thatn 8192 non-contiguous areas, then this might be a problem.

I tried your code with about 5000 rows and it worked fine (it deleted rows contained in 939 non-contiguous ranges).

--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.