Insert Variable Number of Rows

I was playing with some VBA code that would permit me to choose an insertion
point, lets say A4, and then insert variable numbers of rows, based on the
values in a certain column, lets say column A€¦and of course it will start at
the insertion point that the user chooses So far, this is what I have:

Sub InsertAnyRows()

Dim insertNumber As Range
Dim insertStart As Range
Dim redRng As Range
Dim i As Integer
Set insertNumber = Application.InputBox _
(Prompt:="Select a point to insert rows.", Title:="Add a row", Type:=8)

insertNumber.Select
If insertNumber <= 0 Then
MsgBox ("Invalid Number Entered")
Exit Sub
End If

Dim lastrow As Integer
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Resize(insertNumber).Insert
ActiveCell.Offset(1, 0).Select
Do
For x = i To 1
Set redRng = Range("A1", Range("A10").End(xlUp))
For Each Cell In redRng
Selection.EntireRow.Resize(insertNumber).Insert
If ActiveCell.Offset(0, 0).Select = "" Then
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Resize(insertNumber).Insert
End If
Next Cell
Next x
Loop Until ActiveCell.Offset(0, 0).Select = ""
End Sub


There is some problem with the loop and I just cant figure it out. Please
help!!!
Thanks so much!!
Ryan--

--
RyGuy