That seems to do the trick!

Thanks again.

Garry

"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Garry,

Try this version.

HTH,
Bernie
MS Excel MVP

Sub InsertBlanksForGarry2()
Dim myRange As Range
Dim myCnt As Long

On Error Resume Next
Columns("A:A").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
Range("A1").EntireColumn.Insert
Set myRange = Range("A2:A" & Range("B65536").End(xlUp).Row)
Range("A1").Formula = 1
Range("A2").FormulaR1C1 = _
"=IF(LEFT(RC[1], 1) = ""["", R[-1]C+1,R[-1]C)"
Range("A2").AutoFill Destination:=myRange, _
Type:=xlFillDefault
myRange.Copy
myRange.PasteSpecial Paste:=xlPasteValues
Application.Calculate
myCnt = Application.Max(Range("A:A"))
myRange(myRange.Rows.Count + 1).Value = 1
myRange(myRange.Rows.Count + 1).Resize(myCnt, 1).DataSeries _
Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Stop:=myCnt, Trend:=False

Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending
Selection.EntireColumn.Delete
Range("A1").Select
End Sub