For Each loop recheck

[Riddler]

I have a for each loop that loops through a range of cells. My problem
is that if my criteria is met I delete the current row. The problem is
that the for each loop moves on to the next item which is really 1 more
down now that I deleted a row. How can I make it recheck the current
row? I basically want it to back up 1 and then let the for each move
ahead 1 to get me to the same line (which is the new one because of the
deleted row).

Here is the code I have.

Sub MoveCompleted()
Dim LastRow
For Each cell In Sheets("Master Project List").Range("I7:I500")
Debug.Print cell.Value
If cell <> "" Then
Row = cell.Row
Sheets("Completed Projects").UsedRange '<<-- Reset Used
Range!!
LastRow = Sheets("Completed
Projects").Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Sheets("Master Project List").Range(Row & ":" & Row).Cut
Sheets("Completed Projects").Range(LastRow & ":" & LastRow)
Sheets("Master Project List").Range(Row & ":" & Row).Delete
End If
Next cell
End Sub

Thanks
Scott

 

[Don Guillett]

Work from the bottom up. Use this idea and report you final solution here.

for i = 500 to 7 step -1
if cells(i,"a")="mycriteria" then rows(i).delete
next i

 

[Norman Jones]

Hi Scott,

Try:

'=============>>
Sub MoveCompleted()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim i As Long
Dim CalcMode As Long

Set WB = ThisWorkbook
Set SH = WB.Sheets("Master Project List")
Set Rng = SH.Range("I7:I500")

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

For i = Rng.Cells.Count To 1 Step -1
With Rng.Cells(i)
Debug.Print .Value
If .Value <> "" Then
.EntireRow.Delete
End If
End With
Next i

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'<<=============

 

[Riddler]

Here is what I came up with. It is crude but works good. When it
deletes a row it jumps out of the loop and starts over again. My list
will never be very long so it wont have any performance issues.

Private Sub CommandButton1_Click()
Dim LastRow
10 For Each cell In Sheets("Master Project List").Range("I7:I500")
If cell <> "" Then
Row = cell.Row
Sheets("Completed Projects").UsedRange '<<-- Reset Used
Range!!
LastRow = Sheets("Completed
Projects").Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Sheets("Master Project List").Range("A" & Row & ":" & "P" &
Row).Cut Sheets("Completed Projects").Range(LastRow & ":" & LastRow)
Sheets("Master Project List").Range("A" & Row & ":" & "P" &
Row).Delete
GoTo 10 'Restart the loop because a row was deleted
End If
Next cell
With Sheets("Completed Projects").Range("A440000")
.Sort Key1:=Sheets("Completed Projects").Range("I3"),
Order1:=xlDescending
End With
End Sub


Scott

 

[Don Guillett]

Why not learn to do it properly?

 

[Riddler]

Why not learn to do it properly?

Wow what a concept !!!!!!!!!!!!!!!!!

I normally do what you mention but I am trying to learn better code
practices than hacker coding, of which I know a lot.

 

[Don Guillett]

Obviously