Is there a faster loop than this

  • Thread starter Thread starter Andibevan
  • Start date Start date
A

Andibevan

I am currently using the following loop to delete unwanted rows from a
specified sheet on a workbook:-

Sub RemoveUnwantedRows_Plog(wbCopy As Excel.Workbook)
Dim rngActive As Range, Cell As Range

With wbCopy.Worksheets("Project Log Form")
Dim rw As Long: rw = .Cells(Rows.count, "A").End(xlUp).Row
Set rngActive = .Range("A9:A" & rw)

Dim r As Long
For r = rw To 9 Step -1
If UCase(.Range("G" & r)) = "CLOSED" Then
.Rows(r).Delete
End If
Next r
End With
End Sub


Is this the most efficient loop that I could use? It takes about 2 minutes
to complete this loop on a spreadsheet with about 1400 rows. Admittedly
this is on quite a small laptop so would be faster on a desktop but could I
improve on my code.

TIA

Andi
 
I think your loop is ok but there might be a better approach to this
Sub RemoveUnwantedRows_Plog(wbCopy As Excel.Workbook)
Dim rngActive As Range, Cell As Range


With wbCopy.Worksheets("Project Log Form")
Dim rw As Long: rw = .Cells(Rows.count, "A").End(xlUp).Row
Set rngActive = .Range("A8:A" & rw)
rngActive.AutoFilter
rngActive.AutoFilter Field:=7, Criteria1:="=*closed*", _
Operator:=xlAnd
.Range("A9").CurrentRegion.SpecialCells(xlCellTypeVisible) _
.EntireRow.Delete
rngActive.AutoFilter
End With
End Sub


HTH

Charles Chickering
 
Sub RemoveUnwantedRows_Plog(wbCopy As Excel.Workbook)
Dim rngActive As Range, Cell As Range
Dun rng as Range

With wbCopy.Worksheets("Project Log Form")
Dim rw As Long: rw = .Cells(Rows.count, "A").End(xlUp).Row
Set rngActive = .Range("A9:A" & rw)

Dim r As Long
For r = rw To 9 Step -1
If UCase(.Range("G" & r)) = "CLOSED" Then
if rng is nothing then
set rng = .Range("G" & r)
else
set rng = Union(rng,.Range("G" & r))
end if
End If
Next r
End With
if not rng is nothing then
rng.EntireRow.Delete
end if
End Sub

another way is to use find

Sub RemoveUnwantedRows_Plog(wbCopy As Excel.Workbook)
dim rng as Range
Set rng = Nothing
Do
if not rng is nothing then
rng.EntireRow.Delete
end if
set rng = wbcopy.Columns(7).Find( _
What:="Closed", _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

Loop until rng is nothing
End Sub
 
might need a bit more tweaking to avoid deleting the header row (or rows
above A8 that are contiguous and filled):

Just to demo from the immediate window.

Range("A8:H8").Resize(20).Formula = "=Rand()"
? range("A9").CurrentRegion.Address
$A$8:$H$27
 
Good point. Maybe one day I'll think of all these things like you :) Oh
well I started learning VBA about 8 months ago so I don't think I'm
doing to bad so far.
How about this:
Range("A9",Cells(Range("A9").End(xlDown).Row,Range("A9").End _
(xltoRight).Column)).SpecialCells(xlCellTypeVisible).EntireRow.Delete

Charles
 
Back
Top