Look for specific text string, insert row below, insert text to that row

This uses the .Find method

Sub Routers()
    
    Dim Found As Range, FirstFound As String, counter As Long
        
    Application.ScreenUpdating = False
        
    Set Found = Range("A:A").Find(What:="primary ""igp""", _
                                  LookIn:=xlValues, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  MatchCase:=False)
                
    If Not Found Is Nothing Then
        
        FirstFound = Found.Address
        
        Do
            If InStr(1, Found.Offset(1), "Adaptive", 1) = 0 Then
                Found.Offset(1).Insert Shift:=xlShiftDown
                counter = counter + 1
            End If
            
            Set Found = Range("A:A").FindNext(After:=Found)
            
        Loop Until Found.Address = FirstFound
        
    End If
    
    Application.ScreenUpdating = True
    
    MsgBox counter & " rows inserted. ", vbInformation, "Adaptive Inserts Complete"
    
End Sub

Originally Posted by jwats

AlphaFrog,

This is very close, but when I run the code it finds primary "igp" and inserts blank row, but doesn't put the word adaptive, it does however leave the rows alone that already have adaptive. Can you have a second look?

I missed that part. Sorry.

Sub Routers()
    
    Dim Found As Range, FirstFound As String, counter As Long
        
    Application.ScreenUpdating = False
        
    Set Found = Range("A:A").Find(What:="primary ""igp""", _
                                  LookIn:=xlValues, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  MatchCase:=False)
                
    If Not Found Is Nothing Then
        
        FirstFound = Found.Address
        
        Do
            If InStr(1, Found.Offset(1), "Adaptive", 1) = 0 Then
                Found.Offset(1).Insert Shift:=xlShiftDown
                Found.Offset(1).Value = "adaptive"
                counter = counter + 1
            End If
            
            Set Found = Range("A:A").FindNext(After:=Found)
            
        Loop Until Found.Address = FirstFound
        
    End If
    
    Application.ScreenUpdating = True
    
    MsgBox counter & " rows inserted. ", vbInformation, "Adaptive Inserts Complete"
    
End Sub