View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Norman Jones Norman Jones is offline
external usenet poster
 
Posts: 5,302
Default Loop removal or optimization

Hi Matt,

Try something like:

'================
Public Sub DeleteRange()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim delRng As Range
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long
Dim ViewMode As Long
Const sStr As String = "ABC" '<<===== CHANGE

Set WB = ActiveWorkbook '<<===== CHANGE
Set SH = WB.Sheets("Sheet3") '<<===== CHANGE

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveWindow
ViewMode = .View
.View = xlNormalView
End With

SH.DisplayPageBreaks = False

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To iLastRow
If Not Trim(Cells(i, "A").Value) = sStr Then
If delRng Is Nothing Then
Set delRng = Cells(i, "A")
Else
Set delRng = Union(Cells(i, "A"), delRng)
End If
End If
Next i

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
End If

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

ActiveWindow.View = ViewMode

End Sub
'<<================


---
Regards,
Norman


"-matt" wrote in message
oups.com...
I have some code I have written in VBA that is using a Do While loop.
The code works fine, however, it is very slow. I am fairly new to Excel
programming and have a very limited knowledge of the available
functionality in the VBA language. So I was wondering if someone might
help me optimize my loop or possibly remove it completely. It seems to
me that there should be some command I don't know about that would
really help me out. Maybe a sort or find or putting results in a
collection or something, I just don't know.

My code basically compares the value of the (intField) column to a
string (Str) for every row from the first to last (both ints) row. If
the value of the (intField) column is not equal to Str then the row is
deleted and the remaining rows are shifted up. Here is my code.

i = first
last = last + 1
Do While i < last
If Not Trim(ws.Cells(i, intField).Value) = Str Then
ws.Rows(i).Delete Shift:=xlShiftUp
' need to recheck same row b/c of shift and there is one less
row
i = i - 1
last = last - 1
End If
i = i + 1
Loop

Thanks for any help in advance. If you need any other info, just ask.