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.

Well, one thing you could do that would probably speed it up a bit is
to stop the screen from updating while the macro is running. Use:
Application.ScreenUpdating = False before your loop and make sure to
turn it back on after your loop using: Application.ScreenUpdating =
True

This help speed things up for me when deleting rows and such.

-JK

-matt wrote:
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.

I agree that turning off ScreenUpdating is a good idea.
You might also want to turn of automatic calculation
for the duration of the loop (as long as this doesn't
prevent the values you're checking from being set correctly).

dim oldCalcMode as Long
oldCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
'
' your code here
'
Application.Calculation = oldCalcMode


Andrew


JK wrote:
Well, one thing you could do that would probably speed it up a bit is
to stop the screen from updating while the macro is running. Use:
Application.ScreenUpdating = False before your loop and make sure to
turn it back on after your loop using: Application.ScreenUpdating =
True

This help speed things up for me when deleting rows and such.

-JK

-matt wrote:
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.

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.

Hi Matt,

Replace my suggested code with:

'================
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

With SH
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
End With

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



"Norman Jones" wrote in message
...
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.

Thanks for the help everyone. I will give it a try. Sorry I forgot to
mention that I have already turned off ScreenUpdating, but I haven't
heard of that Application.Calculation thing so I will give that a try
too.

Norman- thanks for the code. I'll let you know how it turns out.

Thanks for the help Norman. It worked like a charm. It sorted almost
instantly. Thanks again.