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