Deleting Rows when using for each cell in loop

[paddysheeran]

Hi All,

I have the following code that checks each cell in range for a certain condition. If it meets the criteria then the entire row is deleted. The problem I'm having is that once a row is deleted the "Next Cell" potion of the code jumps down a row rather than dealing with the next cell in the range. Is there a quick fix to amend this issue?

[vba]Sub remove_WE_Dates_Outside_Period()

Dim Range1 As Range

Set Range1 = Range(ActiveCell, ActiveCell.End(xlDown))
For Each cell In Range1
If DateValue(cell) < DateSerial(Year(Date), Month(Date) - 1, 1) Then

cell.EntireRow.Delete

Else


If DateValue(cell) < DateSerial(Year(Date), Month(Date) - 1, 1) Then

cell.EntireRow.Delete

Else

If DateValue(cell) >= DateSerial(Year(Date), Month(Date), 1) Then

cell.EntireRow.Delete

Else

If Weekday(cell, vbMonday) = 6 Or Weekday(cell, vbMonday) = 7 Then
cell.EntireRow.Delete
Else

End If
End If
End If
End If
Next cell[/vba]

thanks in advance.

Paddy.

[Bob Phillips]

bottom-up!

[vba]Sub remove_WE_Dates_Outside_Period()
Dim col As Long
Dim i As Long

col = ActiveCell.Column
For i = ActiveCell.End(xlDown).Row To ActiveCell.Row Step -1

If DateValue(Cells(i, col).Value) < DateSerial(Year(Date), Month(Date) - 1, 1) Or _
DateValue(Cells(i, col).Value) >= DateSerial(Year(Date), Month(Date), 1) Or _
Weekday(cell, vbMonday) = 6 Or Weekday(cell, vbMonday) = 7 Then

Rows(i).Delete
End If
Next i
End Sub
[/vba]

[paddysheeran]

Hi thanks will test shortly. can you tell me what the Step-1 portion of the code is doing? I've never used Step before.

[Bob Phillips]

A normal For i = ... Next loop increments i by 1 every iteration of the loop. By using Step, you can increment by some other value. In this code I am using step -1 which increments by -1, or decrements by 1, which has the effect of working from the bottom upwards.

[Bob Phillips]

Just spotted that I miseed a couple of references to the cell objectr

[vba]
Sub remove_WE_Dates_Outside_Period()
Dim col As Long
Dim i As Long

col = ActiveCell.Column
For i = ActiveCell.End(xlDown).Row To ActiveCell.Row Step -1

If DateValue(Cells(i, col).Value) < DateSerial(Year(Date), Month(Date) - 1, 1) Or _
DateValue(Cells(i, col).Value) >= DateSerial(Year(Date), Month(Date), 1) Or _
Weekday(Cells(i, col).Value, vbMonday) = 6 Or Weekday(Cells(i, col).Value, vbMonday) = 7 Then

Rows(i).Delete
End If
Next i
End Sub [/vba]

[paddysheeran]

Hi,

If I wanted to incorporate bank holidays into the if statement is there any easy way to do this? they are:

02/01/2012
06/04/2012
09/04/2012
07/05/2012
04/06/2012
05/06/2012
27/08/2012
25/12/2012
26/12/2012


thanks,

Paddy.

[Bob Phillips]

Assuming the holiday dates are in M1:M10

[vba]
Sub remove_WE_Dates_Outside_Period()
Dim col As Long
Dim i As Long

col = ActiveCell.Column
For i = ActiveCell.End(xlDown).Row To ActiveCell.Row Step -1

If DateValue(Cells(i, col).Value) < DateSerial(Year(Date), Month(Date) - 1, 1) Or _
DateValue(Cells(i, col).Value) >= DateSerial(Year(Date), Month(Date), 1) Or _
Not IsError(Application.Match(Cells(i, col).Value, Range("M1:M10"), 0)) Or _
Weekday(Cells(i, col).Value, vbMonday) = 6 Or _
Weekday(Cells(i, col).Value, vbMonday) = 7 Then

Rows(i).Delete
End If
Next i
End Sub
[/vba]

[snb]

That's why MS invented autofilter: if you filter all rows that do not meet your criteria you can easily delete those.

[paddysheeran]

I need the dates to be built into the query something like (02/01/2012, 06/04/2012,09/04/2012). Can this be done?

[Bob Phillips]

You could stuff them into an array and use that array rather than the Range M1:M10.

[paddysheeran]

Could you show me how to do that within the formula - I'm not familiar with arrays as they have not come up in the code I've been writing so far.

[Bob Phillips]

[VBA]Sub remove_WE_Dates_Outside_Period()
Dim vecDates(1 To 9) As Date
Dim col As Long
Dim i As Long

vecDates(1) = DateSerial(2012, 1, 2)
vecDates(2) = DateSerial(2012, 4, 6)
vecDates(3) = DateSerial(2012, 4, 9)
vecDates(4) = DateSerial(2012, 5, 7)
vecDates(5) = DateSerial(2012, 6, 4)
vecDates(6) = DateSerial(2012, 6, 5)
vecDates(7) = DateSerial(2012, 8, 27)
vecDates(8) = DateSerial(2012, 12, 25)
vecDates(9) = DateSerial(2012, 12, 26)

col = ActiveCell.Column
For i = ActiveCell.End(xlDown).Row To ActiveCell.Row Step -1

If DateValue(Cells(i, col).Value) < DateSerial(Year(Date), Month(Date) - 1, 1) Or _
DateValue(Cells(i, col).Value) >= DateSerial(Year(Date), Month(Date), 1) Or _
Not IsError(Application.Match(Cells(i, col).Value, vecDates, 0)) Or _
Weekday(Cells(i, col).Value, vbMonday) = 6 Or _
Weekday(Cells(i, col).Value, vbMonday) = 7 Then

Rows(i).Delete
End If
Next i
End Sub
[/VBA]

[parttime_guy]

Hi All,

Apologies xld and sorry to butt in.

I used codes from the net to solve the similar type of problem (attached is a sample file).

This sample file has a "Data" & "Criteria" flap

Hope this helps Paddy

Kindly review.

Best Regards

[snb]

In that case I'd prefer:

[VBA]Sub snb()
sn = Sheets("criteria").Columns(1).SpecialCells(2)

For j = 2 To UBound(sn)
Sheets("data").Columns(1).Replace sn(j, 1), ""
Next

Sheets("data").Columns(1).SpecialCells(4).EntireRow.Delete
End Sub[/VBA]

[Bob Phillips]

Nor at all mate, all insights are to be welcomed.

I have just run your code and two things to note:

- it only seems to delete that listed dates, whereas Paddy wants to delete all dates not in April 2012, plus weekends, plus holidays

- I said seems because when I ran it it deleted nothing - this is a perennial problem using dates with autofilter.

I am sure the former could be easily addressed with extra conditions. The latter works if I change the autofilter line to

[VBA] .Range("A2:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=CStr(cell.Value)
[/VBA]

As the issue is probably regional settings, I don't know if that works for you.

But as it needs extra conditions, I would add a helper column with formula to check if last month, not weekends, not holidays, and filter that column by FALSE.

[parttime_guy]

Hi All,

I have included the code to delete weekends.

Kindly review attached file.

Best Regards