Adding 100 rows automatically when column text changes

Hi
I need to add 100 rows when colums text changes. I have tried one or two of the already mentioned codes (and changed the numbers) but it does not seem to work as I want it to.

Re: Adding 100 rows automatically when column text changes

The first one:

Sub InsertAfterChange()

r = ActiveCell.Row ' get starting row
c = ActiveCell.Column ' and column
ContentOld = Cells(r, c) ' get starting value

Do While Not IsEmpty(Cells(r, c)) ' go until empty cell is found
ContentNew = Cells(r, c) ' read cell value into variable
If ContentOld <> ContentNew Then ' did it change
Cells(r, c).EntireRow.Insert ' changed, insert row above new value
ContentOld = ContentNew ' remember new value
r = r + 2 ' adjust for inerted row
Else
r = r + 1
End If
Loop

End Sub

2.Sub InsertRow()
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
With Range("A" & i)
If .Value <> .Offset(-1).Value Then Rows(i).Insert
End With
Next i
Application.ScreenUpdating = True
End Sub

They work fine but not in the way that I would like to.

Re: Adding 100 rows automatically when column text changes

Sub InsertAfterChange()


    r = ActiveCell.Row ' get starting row
    c = ActiveCell.Column ' and column
    ContentOld = Cells(r, c) ' get starting value


    Do While Not IsEmpty(Cells(r, c)) ' go until empty cell is found
        ContentNew = Cells(r, c) ' read cell value into variable
        If ContentOld <> ContentNew Then ' did it change
            Cells(r, c).EntireRow.Insert ' changed, insert row above new value
            ContentOld = ContentNew ' remember new value
            r = r + 2 ' adjust for inerted row
        Else
            r = r + 1
        End If
    Loop


End Sub

Sub InsertRow()
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    For i = LR To 2 Step -1
        With Range("A" & i)
            If .Value <> .Offset(-1).Value Then Rows(i).Insert
        End With
    Next i
    Application.ScreenUpdating = True
End Sub

These codes only places one empty row in between whereas I would like that it could place 99 rows inbetween