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




Reply With Quote
