Insert 5 Rows above Specific Text

[Andy15]

Hi all,

I am looking to find the text "Final" in column B and insert 5 entire rows above it.

Thanks for any help
Andy

 

[Fluff]

How about

Sub Final()
   Dim fnd As Range
   Set fnd = Range("B:B").find("final", , xlValues, xlWhole, , , False, , False)
   If Not fnd Is Nothing Then fnd.EntireRow.Resize(5).Insert
End Sub

 

[My Aswer Is This]

Try this:

Sub My_Find()
'Modified  8/10/2018  5:01:51 PM  EDT
Dim SearchString As String
Dim SearchRange As Range
Dim Lastrow As Long
Dim r As Long
Lastrow = Cells(Rows.Count, "B").End(xlUp).Row
SearchString = "Final"
Set SearchRange = Range("B1:B" & Lastrow).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then MsgBox SearchString & "  Not foud": Exit Sub
r = SearchRange.Row
Rows(r).Resize(5).Insert shift:=xlUp
End Sub

 

[Andy15]

Hi Fluff

Thanks it worked a treat

Thanks for your time.

 

[Andy15]

Hi

Thanks for supplying the code
works great

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

Hi

Thanks for supplying the code
works great