Find a Partial text and Insert A Column Above The Text

[unknownymous]

Hi Guys,

Can you help me tweak the code below for below table?

No	x
1	Sean
2
3	Output Submitted To Department
4	Output Submitted To Deparmnt
5	Output Sbmitted To Dpartment

<tbody>
</tbody>

-------------------------------------------------------------------
Sub AddRow()


Dim SrchRng As Range, cel As Range


Set SrchRng = Range("B:B")


For Each cel In SrchRng
If InStr(1, cel.Value, "OUTPUT") > 0 Then
cel.Offset(1, 0).EntireRow.Insert
End If
Next cel


End Sub

---------------------------------------------------------------------

The code is working but I wanted to insert a column on the FIRST found "OUTPUT" word in B column and not repetitively add in every word found.


Any help will be much appreciated.

 

[Michael M]

Try

Sub AddRow()
Dim SrchRng As Range, cel As Range, s as Integer
Set SrchRng = Range("B:B")
s = 0
For Each cel In SrchRng
    If s = 1 Then Exit Sub
        If InStr(1, cel.Value, "Output") > 0 Then
            cel.Offset(1, 0).EntireRow.Insert
            s = s + 1
    End If
Next cel
End Sub

 

[unknownymous]

The code is working but need to insert the row above the word "Output". Thanks for the help.

 

[Michael M]

Try

Sub AddRow()
Dim SrchRng As Range, cel As Range, s as Integer
Set SrchRng = Range("B:B")
s = 0
For Each cel In SrchRng
    If s = 1 Then Exit Sub
        If InStr(1, cel.Value, "Output") > 0 Then
            cel.Offset(-1, 0).EntireRow.Insert
            s = s + 1
    End If
Next cel
End Sub

 

[unknownymous]

Thanks Michael but additional row is inserted above the data next to "Output".

It looks like this:

Cell B12: Inserted Blank
Cell B13: Sean
Cell B14: Output

Should be:

Cell B12: Sean
Cell B13: Inserted Blank
Cell B14: Output

Thanks again!

 

[Michael M]

Try then

Sub AddRow()
Dim SrchRng As Range, cel As Range, s As Integer
Dim lr As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
Set SrchRng = Range("B1:B" & lr)
s = 0
For Each cel In SrchRng
    If s = 1 Then Exit Sub
        If InStr(1, cel.Value, "Output") > 0 Then
            cel.EntireRow.Insert
            s = s + 1
    End If
Next cel
End Sub

 

[unknownymous]

Works perfectly! Thanks a lot Michael

 

[Michael M]

glad to help...