Code Needed To Loop Through Certain Rows

[MWS-C360]

I'm using VBA 6.5 and trying to write the code other users will initiate via
a control within a file/worksheet.

I have code that prepares imported data in a worksheet, which essentially
identifies rows that should be untouched as well as those that should be
deleted. I need to incorporate a portion of code to loop through rows 1
through 15,000 and then again through 20,000 through 25,000, and delete each
row which has the word "DELETE" in a given column of the worksheet.

I tried the code below, but since it loops through all the rows of the file,
it takes quite awhile to complete. Since this is will be excuted by front-end
users, the code needs to be added to the existing macro/control.

Question: How can I edit the code to only process through the two sets of
rows (ie 1-15,000 and then 20,000-25,000)? If this needs to be done in one
step to address the first set of rows, and a secondary step for the other set
of rows, that is fine.

Any assistance would be greatly appreciated. I do not have much experience
posting questions, so hopefully this question is being sent to the proper
group. Thank You

'DELETES ROWS PREDETERMINED TO BE DELETE-ABLE
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1

If IsError(.Cells(Lrow, "AY").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

ElseIf .Cells(Lrow, "AY").Value = "DELETE" Then
.Rows(Lrow).Delete
End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

 

[Rick Rothstein]

Give this macro a try...

Sub DELETErows()
Dim C As Range, FoundCells As Range, FirstAddress As String
With ActiveSheet.Columns("AY")
Set C = .Find("DELETE", LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
If FoundCells Is Nothing Then
Set FoundCells = C
Else
Set FoundCells = Union(FoundCells, C)
End If
Set C = .Find("DELETE", After:=C, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
If Not FoundCells Is Nothing Then FoundCells.EntireRow.Delete
End With
End Sub

 

[Ron de Bruin]

Hi MWS-C360

See the filter or union or example
http://www.rondebruin.nl/delete.htm

 

[Ryan H]

I would just run two different loops. Plus I modified the code just a bit.
There really isn't a need to use ActiveSheet in this case because in code
like this below it is assumed it is the activesheet. Hope this helps! If
so, click "YES" below.

Sub DeleteRows()

Dim i As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

' delete rows with "DELETE" 1-15000
FirstRow = 1
LastRow = 15000
For i = LastRow To FirstRow Step -1
If Cells(i, "AY").Value = "DELETE" Then
Rows(i).EntireRow.Delete Shift:=xlUp
End If
Next i

' delete rows with "DELETE" 20000-25000
FirstRow = 20000
LastRow = 25000
For i = LastRow To FirstRow Step -1
If Cells(i, "AY").Value = "DELETE" Then
Rows(i).EntireRow.Delete Shift:=xlUp
End If
Next i

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub

 

[MWS-C360]

Ryan, Thank You for taking the time to try and help me, I appreciate it!!

This worked perfectly -- Thank You!!!!

 

[Ron de Bruin]

Filter or union is much faster with a lot of data
See my site for examples or see Ricks example