Hi TroyT,

I have cooked something for you:

Sub InsertCells()

Range("A2").Select ' or any other cell to start

Do
Select Case StrComp(ActiveCell.Value, ActiveCell.Offset(0,
1).Value, vbTextCompare)
Case 1
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Cut Destination:=ActiveCell.Offset(1, 0)
ActiveCell.Interior.Color = vbGreen
Case -1
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0,
1).End(xlDown)).Select
Selection.Cut Destination:=ActiveCell.Offset(1, 0)
ActiveCell.Interior.Color = vbRed
ActiveCell.Offset(0, -1).Select
Case 0
End Select
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell) Or IsEmpty(ActiveCell.Offset(0, 1))
End Sub

Hoop This Helps,

Executor