Insert 2 blank rows after each cell containing text in column A

[abhay_547]

I have column A populated with some text in cells after regular intervals.. for e.g. it starts from row A4 where i have company name and after 16 or 17 blank rows I again have one more company name and so on the it goes for around 8000+ rows in column A, so after each company name cell I want to insert 2 blank rows but not the entire row just shift the cells down in column A. Below is what I have got...

Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("a4")

iRow = oRng.Row
iCol = oRng.Column

Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).Insert shift:=xlDown
    iRow = iRow + 2

End If
'
Loop While Not Cells(iRow, iCol).Text = ""
'
End Sub