Macro to find-insert and Prompt user for Text Loop

Hello. I am trying to write a macro that will search down column B, find a User Prompted Term, insert a blank row beneath it and continue this for all instances. I have managed to get this to work with the macro below.

HELP: What I am trying to achieve on my next step is to have the User Prompted again for the Text to have populated in the new, inserted rows ( all instances). Please let me know if this does not make sense. And the "Text" should go into the cell in column B. Thank you in advance for any help!

Sub Insertextracolumns()
'
' Insertextracolumns Macro
'
    Dim strReply As String
    Dim lReply As Long
     
Set vFound = Cells.Find(What:=InputBox("Please Enter Term to Search For:"), _
After:=Cells(1, 1), LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
     
    If strReply = vbNullString Then
        lReply = MsgBox("Do you wish to cancel?", vbYesNo)
        If lReply = vbYes Then
            Exit Sub
        Else

     
If Not vFound Is Nothing Then
vStart = vFound.Address
Do
Rows(vFound.Row + 1).Insert (xlShiftDown)
Set vFound = Cells.FindNext(vFound)
Loop Until vFound.Address = vStart
Else
MsgBox ("Not Found")
End If

        End If
    End If

End Sub