Hi Richard

Something like this would work for you

Sub AllignRows()
Dim Rng As Range
Dim Lastrow As Single

Lastrow = Range("A" & Rows.Count).End(xlUp).Row

Set Rng = Range("A1:A" & Lastrow)

For Each c In Rng
If c.Value < c.Offset(0, 1).Value Then
c.EntireRow.Insert
c.Offset(-1, 0).Delete
End If
Next c

End Sub

HTH

Davi

--
Message posted from http://www.ExcelForum.com