Delete rows based on a condition

[backspace20]

Hi,
I have a sprea sheet with data related to irrigation of farms . First column contains the first day which the farm irrigated. The second column contains farm name and the 3rd column is duration of irrigation in days. I want to remove the irrigation which is in unusual time for each farm( in my case if (difference in date - irrigation duration) > 10 days (in other words if the farm have not received water for more than 10 days then remove the row related to that date.
I have written the following code, but it does not work



Sub pak3()

Dim i As Integer, Lastrow As Long


Sheet4.Activate
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lastrow
If Cells(i, 2).Value = Cells(i + 1, 2).Value Then
If Cells(i + 1, 1).Value - Cells(i, 1).Value - Cells(i, 3).Value > 10 Then
If Cells(i + 2, 1).Value - Cells(i + 1, 1).Value - Cells(i + 1, 3).Value > 10 Then
Rows.Delete (i + 1)
Else:
Rows.Delete (i)
End If
End If
End If
Next i


End Sub

To make it clear I have attached my file. In this example rows 3 and 25(yellow rows) must be removed by code

[backspace20]

Hi,
I have a sprea sheet with data related to irrigation of farms . First column contains the first day which the farm irrigated. The second column contains farm name and the 3rd column is duration of irrigation in days. I want to remove the irrigation which is in unusual time for each farm( in my case if (difference in date - irrigation duration) > 10 days (in other words if the farm have not received water for more than 10 days then remove the row related to that date.
I have written the following code, but it does not work



Sub pak3()

Dim i As Integer, Lastrow As Long


Sheet4.Activate
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lastrow
If Cells(i, 2).Value = Cells(i + 1, 2).Value Then
If Cells(i + 1, 1).Value - Cells(i, 1).Value - Cells(i, 3).Value > 10 Then
If Cells(i + 2, 1).Value - Cells(i + 1, 1).Value - Cells(i + 1, 3).Value > 10 Then
Rows.Delete (i + 1)
Else:
Rows.Delete (i)
End If
End If
End If
Next i


End Sub

To make it clear I have attached my file. In this example rows 3 and 25(yellow rows) must be removed by code

cheers

[SamT]

Two almost duplicate threads combined by Moderator

[tiesja]

comments in code show your statements in error

else: the colon turns this into a label



Sub pak3()

Dim i As Integer, Lastrow As Long

Sheet4.Activate
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
'----------
'For i = 2 To Lastrow
For i = 2 To Lastrow - 2
'----------
If Cells(i, 2).Value = Cells(i + 1, 2).Value Then
If Cells(i + 1, 1).Value - Cells(i, 1).Value - Cells(i, 3).Value > 10 Then
If Cells(i + 2, 1).Value - Cells(i + 1, 1).Value - Cells(i + 1, 3).Value > 10 Then
'----------
'Rows.Delete (i + 1) <-- this deletes all the rows
Rows(i + 1).Delete
'Else:
Else
'Rows.Delete (i)
Rows(i).Delete
End If
'----------
' delete caused table end to move up
Lastrow = Lastrow - 1
'----------
End If
End If
Next i


End Sub

[SamT]

tiesja's corrections are right, but it is best to always delete Rows from bottom up and Columns from right to left


Sub pak3()

Dim i As Integer, Lastrow As Long

Sheet4.Activate
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
'----------
'For i = 2 To Lastrow
'For i = 2 To Lastrow - 2
For i = Lastrow - 2 to 2
'----------
If Cells(i, 2).Value = Cells(i + 1, 2).Value Then
If Cells(i + 1, 1).Value - Cells(i, 1).Value - Cells(i, 3).Value > 10 Then
If Cells(i + 2, 1).Value - Cells(i + 1, 1).Value - Cells(i + 1, 3).Value > 10 Then
'----------
'Rows.Delete (i + 1) <-- this deletes all the rows
Rows(i + 1).Delete
'Else:
Else
'Rows.Delete (i)
Rows(i).Delete
End If
'----------
' delete caused table end to move up
'Delete from bottom up = no problem
'Lastrow = Lastrow - 1
'----------
End If
End If
Next i

End Sub