Delete rows based on a condition

1 Attachment(s)

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

Code:

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

Delete rows based on a condition

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

Code:

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

Two almost duplicate threads combined by Moderator

comments in code show your statements in error

else: the colon turns this into a label

Code:

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

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

Code:

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