Option Explicit
Sub deburrIt()
Dim arrDo() As Variant
Do
arrDo = doIt()
If arrDo(1) = 0 Then
Exit Do
Else
Rows(arrDo(1)).Insert
With Rows(arrDo(1))
.Cells(1).Value = arrDo(2)
.Cells(2).Value = .Cells(2).Offset(1).Value - 0.09999
.Cells(2).Interior.ColorIndex = 3
End With
End If
Loop
End Sub
Function doIt() As Variant
Dim rngXY As Range, rngComp As Range, arrM(1 To 2) As Variant
On Error GoTo fail:
With Columns(1)
Set rngXY = Range(.Cells(2), .Cells(2).End(xlDown)).Resize(, 2)
Set rngComp = .Cells(2).End(xlDown).Offset(-1).Resize(2, 2)
Do
If rngComp.Cells(4) - rngComp.Cells(2) > 0.10001 Then
arrM(1) = rngComp.Cells(3).Row
arrM(2) = WorksheetFunction.Average(rngComp.Cells(1), rngComp.Cells(3))
doIt = arrM
Exit Do
End If
Set rngComp = rngComp.Offset(-1)
Loop
End With
fail:
If Err.Number > 0 Then
arrM(1) = 0: arrM(2) = 0
doIt = arrM
End If
End Function