Yesterday it was a bit late....Please find the below modified code to handle
blank entries. You can change the while condition if you have more than 1
blanks inbetween.

If this post helps click Yes
---------------
Jacob Skaria

Dim lngRow
Dim lngTemp
Dim lngBlank

lngRow = 1
Do
If Range("A" & lngRow) Like ["######"] Then
If Range("A" & lngRow) < lngTemp Then
Rows(lngRow).Insert
Range("A" & lngRow) = lngTemp
End If
lngTemp = lngTemp + 1
lngBlank = 0
ElseIf Trim(Range("A" & lngRow)) < "" Then
If lngTemp 240229 And lngTemp < 240242 Then
Rows(lngRow).Insert
Range("A" & lngRow) = lngTemp
lngTemp = lngTemp + 1
End If
lngTemp = 240229
lngBlank = 0
Else
lngBlank = lngBlank + 1
End If
lngRow = lngRow + 1
Loop While lngBlank < 2