Loop removal or optimization

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" <[email protected]> wrote in message
news:[email protected]...
>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" <[email protected]> wrote in message
news:[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
>>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.