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

[butters149]

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

 

[steve the fish]

A little change or two gets you there:

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

 

[Fluff]

Try this change

For m = Lastrow2 to 2 step -1

 

[My Aswer Is This]

Try this:
When inserting or deleting rows you must run the loop backwards:

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

 

[Excel Planet]

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

 

[butters149]

Try this:
When inserting or deleting rows you must run the loop backwards:

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 =)

 

[My Aswer Is This]

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

Thank-you, this worked. And thanks everyone for the inputs =)