VBA to find a specific text in a column and add a row above it and loop

butters149

New Member
Joined
Mar 21, 2018
Messages
23
Hello,

I am having some trouble writing up a code on how to find a specific text in column A, then once found it will add a row above it. The problem is that there can be more than one of the same text in that column so I would probably need to loop it too.

Application.ScreenUpdating = False
Dim m As Long
Dim Lastrow2 As Long
Lastrow2 = Cells(Rows.Count, "A").End(xlUp).Row
For m = 1 To Lastrow2
If Cells(m, "A").Value = "sample text" Then Cells(m, "A").Offset(-1, 0).EntireRow.Insert
Next
Application.ScreenUpdating = True
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
A little change or two gets you there:

Code:
Dim m As Long
Dim Lastrow2 As Long

Application.ScreenUpdating = False

Lastrow2 = Cells(Rows.Count, "A").End(xlUp).Row

For m = Lastrow2 To 1 Step -1
    If Cells(m, "A").Value = "sample text" Then Rows(m).Insert Shift:=xlDown
Next

Application.ScreenUpdating = True
 
Upvote 0
Try this change
Code:
For m = Lastrow2 to 2 step -1
 
Upvote 0
Try this:
When inserting or deleting rows you must run the loop backwards:
Code:
Sub Check_Me()
'Modified 4-23-18 2:50 PM EDT
Application.ScreenUpdating = False
Dim m As Long
Dim Lastrow2 As Long
Lastrow2 = Cells(Rows.Count, "A").End(xlUp).Row
For m = Lastrow2 To 1 Step -1
    If Cells(m, "A").Value = "sample text" Then Cells(m, "A").EntireRow.Insert xlShiftDown
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
A colleague of mine shared with me a code that will select all cells having a specific text, I added the insert row at the bottom:

Give it a try and let me know the result.

Sub Insert_After_Match()
Dim c As Range, FoundCells As Range, firstaddress As String
With Sheets(ActiveSheet.Name)
'find first cell that contains "Match" -->>> change as required
Set c = .Cells.Find(What:="Match", After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
xlPart, MatchCase:=False)

'if the search returns a cell
If Not c Is Nothing Then
'note the address of first cell found
firstaddress = c.Address
Do
'FoundCells is the variable that will refer to all of the
'cells that are returned in the search
If FoundCells Is Nothing Then
Set FoundCells = c
Else
Set FoundCells = Union(c, FoundCells)
End If
'find the next instance of "rec"
Set c = .Cells.FindNext(c)
Loop While Not c Is Nothing And firstaddress <> c.Address

'after entire sheet searched, select all found cells
FoundCells.Select
Else
'if no cells were found in search, display msg
MsgBox "No cells found."
End If
End With
Selection.Insert Shift:=xlDown
End Sub
 
Upvote 0
Try this:
When inserting or deleting rows you must run the loop backwards:
Code:
Sub Check_Me()
'Modified 4-23-18 2:50 PM EDT
Application.ScreenUpdating = False
Dim m As Long
Dim Lastrow2 As Long
Lastrow2 = Cells(Rows.Count, "A").End(xlUp).Row
For m = Lastrow2 To 1 Step -1
    If Cells(m, "A").Value = "sample text" Then Cells(m, "A").EntireRow.Insert xlShiftDown
Next
Application.ScreenUpdating = True
End Sub

Thank-you, this worked. And thanks everyone for the inputs =)
 
Upvote 0
I have a similar question to the OP. How can I make it where it inserts a row only when the first word is found and not all words from using xlUp. below is an example chart. I want to keep all the Week, Month, Quarterly and so on in the same group but i want to separate week from month and month from quarterly. I want the code to look from bottom to top and when it sees the first instant of "Week" put a row underneath and the same for the other words.

1728066161716.png
 
Upvote 0
As this is a signifcantly different question & this thread is over 6 years old, you need to start a new thread.
Thanks
 
Upvote 0

Forum statistics

Threads
1,223,530
Messages
6,172,845
Members
452,484
Latest member
vmexwindy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top