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?

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]No[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Sean[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Output Submitted To Department[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Output Submitted To Deparmnt[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Output Sbmitted To Dpartment[/TD]
[/TR]
</tbody>[/TABLE]


-------------------------------------------------------------------
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...