Excel VBA - Insert row above specific text and copy formats and formula

Question

I see there are similar questions to mine however I am unable to find a VBA which includes both of my queries. I am fairly new to VBA and am therefore struggling to combine two codes into a single code which:

Inserts a specified number of rows above a row containing the text "TTDASHINSERTROW" and copies formats and formula from the above row.

The first code I have inserts a number of rows and copies the formula from above but is based on an "Active Cell".

Sub insertRow()

Dim Rng, n As Long, k As Long
Application.ScreenUpdating = False
Rng = InputBox("Enter number of rows required.")
If Rng = "" Then Exit Sub
Range(ActiveCell, ActiveCell.Offset(Val(Rng) - 1, 0)).EntireRow.Insert
'need To know how many formulas To copy down.
'Assumesfrom A over To last entry In row.
k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 256).End(xlToLeft).Column
Range(Cells(k, 1), Cells(k + Val(Rng), n)).FillDown

End Sub

The second code inserts one row based on a search for the text "TTDASHINSERTROW".

Sub insertRow()

  Dim c As Range
  For Each c In Range("A:A")
    If c.Value Like "*TTDASHINSERTROW*" Then
        c.Offset(1, 0).EntireRow.Insert
    End If
  Next c

End Sub

Any help in combining these into a single code which can insert a specified number of rows above the specified text and copies the formats and formula will be appreciated.

UPDATE

I have come up with the following code which allows the user to add a specified number of rows through a pop up window when running the macro. The code still requires an active cell and copies the formula from above that cell.

Sub InsertRow()

Dim d As Integer
d = Range("A:A").End(xlDown).Row
Dim c As Range
For i = d To 1 Step -1
If Cells(i, 1).Value Like "TTDASHINSERTROW" Then

Dim Rng, n As Long, k As Long
Application.ScreenUpdating = False
Rng = InputBox("Enter number of rows required.")
If Rng = "" Then Exit Sub

Range(ActiveCell, ActiveCell.Offset(Val(Rng) - 1, 0)).EntireRow.Insert
'need To know how many formulas To copy down.
'Assumesfrom A over To last entry In row.

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 256).End(xlToLeft).Column
Range(Cells(k, 1), Cells(k + Val(Rng), n)).FillDown


End If
Next
End Sub

Instead of the second part of the code refering to the active cell is it possible for it to find the cell with "TTDASHINSERTROW" and copy the formula and formatting from above that row?

Unfortunately I don't have enough rep to attach a screenshot.

Welcome to Stackoverflow. I am having a deja-vu somewhere with your question... — bonCodigo
@bonCodigo: Does that imply that person did not look well before asking in SO? — Amen Jlili
@JLILIAman, Bingo! However, I will hesitate to exercise strict voting rights given the details that 1. OP has posted a code that he/she tried out, 2. indicated I see there are similar questions to mine however I am unable to find... 3. and this is his/her first post in SO. — bonCodigo
I've searched. Really can't find anything that doesnt reference an active cell. I've tried creating it myself with no luck. — Justin
@Justin, What if you have that particular string in number of adjacent columns and rows? Does it mean you want the function to insert rows up, down, right and left? — bonCodigo

user3819867 user3819867 · Accepted Answer · 2015-03-03T13:07:55

Sub insertRow()
Dim Rng As Long
Rng = InputBox("Enter number of rows required.")
If Rng = 0 Then Exit Sub
Application.ScreenUpdating = False 'this is unnecessary unless you often get seizures
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'tells the number of rows used
LastColumn = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'tells the number of columns used

  For i = 1 To LastRow 'for each row
    If Cells(i, 1).Value Like "*TTDASHINSERTROW*" Then 'if Range("A"&i) is like your string
        For j = 1 To Rng
            Rows(i).EntireRow.Insert
            Range(Cells(i, 1), Cells(i + 1, LastColumn)).FillUp
        Next
    End If
  Next

Application.ScreenUpdating = True
End Sub

Excel VBA - Insert row above specific text and copy formats and formula

2 Answers