Macro Inserts row above the word Type and Highlights is taking too long to run.

[TAMMY32]

Hello Excel Experts,
I have a macro that inserts a row above the word "Type" in column A. The macro works great, but it's like I am stuck in an infinite loop which makes the macro run way too long. Is there a way I can set a range that the first row starts at row A11 and the last row will be A100? Or even better, can I select row A11 down to the last row and have the macro run on the select rows? I would appreciate any help on this. Thank you!!!

Sub InsertRow()
    Dim Lastrow As Long
    Dim I As Long
    Application.ScreenUpdating = False
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    I = 1
    While I <= Lastrow
        If (Len(Cells(I, "A")) <> Len(Replace(Cells(I, "A"), "Type", ""))) Then
            Rows(I & ":" & I).Insert shift:=xlDown
            Rows(I & ":" & I).Interior.ColorIndex = 16
            I = I + 1
        End If
        I = I + 1
        Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Wend
    Application.ScreenUpdating = True
End Sub

[JOHN H. DAVIS]

First question:

Sub TAMMY32()
    Dim Lastrow As Long
    Dim I As Long
    With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    End With
    Lastrow = 100
    I = 11
    While I <= Lastrow
        If (Len(Cells(I, "A")) <> Len(Replace(Cells(I, "A"), "Type", ""))) Then
            Rows(I & ":" & I).Insert shift:=xlDown
            Rows(I & ":" & I).Interior.ColorIndex = 16
            I = I + 1
        End If
        I = I + 1
        Lastrow = Range("A" & Rows.Count).End(xlUp).row
    Wend
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

Second question:

Sub TAMMY32()
    Dim Lastrow As Long
    Dim I As Long
    With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    End With
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    I = 11
    While I <= Lastrow
        If (Len(Cells(I, "A")) <> Len(Replace(Cells(I, "A"), "Type", ""))) Then
            Rows(I & ":" & I).Insert shift:=xlDown
            Rows(I & ":" & I).Interior.ColorIndex = 16
            I = I + 1
        End If
        I = I + 1
        Lastrow = Range("A" & Rows.Count).End(xlUp).row
    Wend
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

[TAMMY32]

Dear John H. D,
It worked beautifully. It went faster using the Lastrow = 100, I = 11. Thank you so much for the help.

[JOHN H. DAVIS]

You're welcome. Glad to help out and thanks for the feedback.