Excel VBA - Insert row above specific text and cop

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.

Answer 1

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

Answer 2

Solved.

All I needed to do with my code is include a "find" function which located the cell containing "TTDASHINSERTROW", therefore making that cell the active cell.

Sub InsertRow()


Cells.Find(What:="TTDASHINSERTROW", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

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

Thanks to everyone for the help on this!