VBA Insert Row After Text Looping

Try this:

Option Explicit

Sub foo()
    Dim lr As Long
    lr = Range("B" & Rows.Count).End(xlUp).Row
    Dim i As Long
    
    Application.ScreenUpdating = False
        For i = 1 To lr
            If Range("B" & i) = "TotSupply" Then
                Range("B" & i + 1).EntireRow.Insert
            End If
        Next i
    Application.ScreenUpdating = True
    MsgBox ("complete")

End Sub

How to install your new code

1. Copy the Excel VBA code
2. Select the workbook in which you want to store the Excel VBA code
3. Press Alt+F11 to open the Visual Basic Editor
4. Choose Insert > Module
5. Edit > Paste the macro into the module that appeared
6. Close the VBEditor
7. Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

To run the Excel VBA code:

1. Press Alt-F8 to open the macro list
2. Select a macro in the list
3. Click the Run button

Try this.

Sub InsertRow()
Dim rng As Range

    Application.ScreenUpdating = False

    Set rng = Range("B6")
    
    While rng.Value <> ""
        rng.Offset(1).EntireRow.Insert
        Set rng = rng.Offset(6)
    Wend
    
    Application.ScreenUpdating = True

End Sub