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, Commented Mar 3, 2015 at 7:50
@bonCodigo: Does that imply that person did not look well before asking in SO? — Amen Jlili
– Amen Jlili, Commented Mar 3, 2015 at 8:25
@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
– bonCodigo, Commented Mar 3, 2015 at 8:56
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, Commented Mar 3, 2015 at 8:56
@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
– bonCodigo, Commented Mar 3, 2015 at 8:59

user3819867 · Accepted Answer · 2015-03-03 13:07:55Z

0

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

answered Mar 3, 2015 at 13:07

user3819867

1,1181 gold badge8 silver badges20 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Justin Over a year ago

This code adds 48 new rows for every 1 row entered in the application box. (I.e Input 1 = 48 new rows, Input 2 = 96 new rows, etc.). The update to the original question is almost correct however just needs adjustment to change the "ActiveCell" to be reference to whatever cells contains "TTDASHINSERTROW"

user3819867 Over a year ago

I assume there are 48 instances of the "TTDASHINSERTROW" in your file. Your solution first finds it then asks for the number, mine takes the input then does the same process for all instances. You forgot to detail your specification, it's GIGO. The correct sub for your case after specification would be adding 1. allow screen update 2. select Cells(i,1) 3. ask for the Rng 4. disallow screen update before the For j =... line.

Justin · Accepted Answer · 2015-03-04 05:10:08Z

0

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!

answered Mar 4, 2015 at 5:10

Justin

111 silver badge4 bronze badges

4 Comments

user3819867 Over a year ago

"Insert row above" is the new "Insert row below." Make sure your string contains wildcards as intended, you've changed that one.

Justin Over a year ago

@user3819867 Not sure I follow what you are saying? I'm not familiar with wildcards. As I have it the code works but should you have found an error which I'm not picking up I'd like to understand your comment.

user3819867 Over a year ago

First: if you do the evaluation for each of the occurrences you might want to use something along the lines of Resume Next in lieu of Exit Sub which completely drops your process instead of going to the next string. The "*" in your string implies that there can be any number of characters at that given place, e.g. "NDKJTTDASHINSERTROWNSGRJL".

Justin Over a year ago

@user3819867 Thanks for clearing that up for me. Will mark this as the correct answer now and close out the query.

Collectives™ on Stack Overflow

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

2 Answers 2

2 Comments

4 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

4 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related