Preventing Conditional Formatting Fracturing

[sparky2205]

Hi folks,
This isn't a question. It's a problem I had which I managed to solve so I thought I'd post my solution in case anyone else came across the same issue. When googleing I found a lot of questions with regard to this but not a lot of solutions.
I have a macro to insert multiple new rows into a protected spreadsheet and copy some formulas.
Everything works fine with the code but it does cause new conditional formatting rules to be added for the newly added rows. This is repeated each time new rows are added which results in a lot of conditional formatting fracturing.
I noticed that if I deleted any row in the newly created range, except the starting position, the conditional formatting fracturing problem was resolved.
So I altered my macro to create one more row than I need each time the button is pressed, then delete the last row. I'm posting the full code below so that it makes more sense.
I hope this might help someone as I've received so much help from this forum.

Sub InsertMultipleRows()
    Dim s As Variant
    Dim n As Variant
    Dim r As Range
    
    On Error GoTo Errhandler:
    
    ' Don't update the screen until the macro has finished processing
    Application.ScreenUpdating = False
    
    ' Get the starting position
    s = Application.InputBox("Enter the starting position", , , , , , , 1 + 2)
    ' If the user clicks on Cancel
    If s = False Then
        Exit Sub
        ' If the user clicks on OK but doesn't enter a number
        ElseIf s = "" Then
        Exit Sub
        End If
    ' Populate variable r with the starting range
    Set r = Range("A" & s)
    ' Get the number of rows to input
    n = Application.InputBox("Enter the number of rows to input", , , , , , , 1 + 2)
    ' Create one extra row to be deleted later to prevent conditional formatting fracturing
    n = n + 1
    ' If the user clicks on Cancel
    If n = False Then
        Exit Sub
        ' If the user clicks on OK but doesn't enter a number
        ElseIf n = "" Then
        Exit Sub
    End If
    ' Copy the row
    r.EntireRow.Copy
        ' Fill down the required number of times
    Range(r.Offset(1, 0), r.Offset(n, 0)).EntireRow.Insert Shift:=xlDown
    ' Populate the first cell of each newly created row with the word "Text"
    Range(r, r.Offset(n - 1, 0)) = ("Text")
    ' Clear the contents of the copied rows except for formulas
    Rows(s).Resize(n).SpecialCells(xlConstants).ClearContents
    ' Delete the extra row created earlier (last row) to prevent conditional formatting fracturing
    Rows(s + (n - 1)).Delete
    ' Clear the clipboard
    Application.CutCopyMode = False
    
    ' Turn this back on
    Application.ScreenUpdating = True
    
    Exit Sub
    
Errhandler:
    Exit Sub
    
End Sub