Add rows above cells containing specific string.

[topi1]

I am hoping someone can help me with the following script.
It changes before to after as follows. I am hoping to change it so that it splits any row like the last row where there are two lookup occurrences ("firewall") and adds a row. Please note how I want row 12 in the "After" to change to rows 12 and 14 as in "Desired after". In fact, if it has third occurrence of "firewall", it should split that again and add row 16.

Additionally, the data in the column A can be anywhere and not necessarily begin at A1. It gives me error if it does not start at A1. I got the script from the web and don't fully understand to do any of these two modifications on my own. Any and all help will be greatly appreciated. Thank you.

Before

rscriptor.xlsm
	O
23	firewall abc
24	x firewall y
25	policy y
26	xyz firewall
27	policy z
28	firewall abc
29	policy xxx
30	x firewall y. xyz firewall
Add row above

After

rscriptor.xlsm
	A
1	firewall abc
2
3	x firewall y
4	policy y
5
6	xyz firewall
7	policy z
8
9	firewall abc
10	policy xxx
11
12	x firewall y. xyz firewall
Add row above

Desired After

rscriptor.xlsm
	A
1	firewall abc
2
3	x firewall y
4	policy y
5
6	xyz firewall
7	policy z
8
9	firewall abc
10	policy xxx
11
12	x firewall y.
13
14	xyz firewall
Add row above

Option Explicit

Sub NewRowInsert()
    
    Const sText As String = "FirEWaLL"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Add row above")
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim rg As Range: Set rg = ws.Range("A2:A" & LastRow)
    Dim sCell As Range: Set sCell = rg.Find(sText, , xlFormulas, xlPart)
    
    Application.ScreenUpdating = False
    
    Dim trg As Range
    Dim sCount As Long
    
    If Not sCell Is Nothing Then
        Dim FirstAddress As String: FirstAddress = sCell.Address
        Do
            If trg Is Nothing Then
                Set trg = sCell
            Else
                Set trg = Union(trg, sCell.Offset(, sCount Mod 2))
            End If
            sCount = sCount + 1
            Set sCell = rg.FindNext(sCell)
        Loop Until sCell.Address = FirstAddress
        trg.EntireRow.Insert
    End If
    
    Application.ScreenUpdating = True
    
    Select Case sCount
    Case 0
        MsgBox "'" & sText & "' not found.", vbExclamation, "Fail?"
    Case 1
        MsgBox "Found 1 occurrence of '" & sText & "'.", _
            vbInformation, "Success"
    Case Else
        MsgBox "Found " & sCount & " occurrences of '" & sText & "'.", _
            vbInformation, "Success"
    End Select

End Sub