How to insert blank row below a cell containing specific text

[Lmsloman]

Good Afternoon Friends,

I was wondering if someone might be able to assist me with using VB to insert a new row below a cell containing specific text.

For example:

- All of my data is in column A
-I want to scan all of column A, and if there is a cell that contains "ACHCAMERIGROUP M", then I want a blank row inserted below it. If column A does NOT contain that text....do nothing.

Thanks so much in advance,

Laura

[davegugg]

Hows this do for ya?

Sub lmsloman()

For a = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If ActiveSheet.Cells(a, 1).Value = "ACHCAMERIGROUP M" Then
        ActiveSheet.Rows(a + 1).Insert
        a = a + 1
    End If
Next a

End Sub

[Lmsloman]

You get a gold star for the day!

Thank you so much!

[JBeaucaire]

If there's only one instance of this value, there's no need to loop, you can jump directly to it:

Option Explicit
Option Compare Text

Sub InsertRow()
Dim rFind As Long
On Error Resume Next

rFind = Columns("A:A").Find(What:="ACHCAMERIGROUP M", After:=Range("A1"), LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

If rFind > 0 Then Rows(rFind + 1).Insert xlShiftDown

End Sub

[Lmsloman]

Unfortunately, I don't know how many instances of this there would be.

But hey, if I wanted to get extra fancy....is there a way to specify to change the newly created blank cell in column A to "NA" or any other specific text?

[davegugg]

Do this instead, its better than the other code anyway as I may have missed some values near the end.

Sub lmsloman()

a = 1

Do Until a = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If ActiveSheet.Cells(a, 1).Value = "ACHCAMERIGROUP M" Then
        ActiveSheet.Rows(a + 1).Insert
        ActiveSheet.Cells(a + 1, 1).Value = "NA"
    End If
    a = a + 1
Loop

End Sub

[Ferdinand]

Hi,

Regarding to the helpfull code provide by DaveGugg, how to change below code to have a row insert ABOVE te value indicated and not BELOW

I have searched, tried almost all day now but didn't succeed. Nevertheless I expect the solution to be fairly simple.

Ferdinand

- - - - - - - -

Sub lmsloman()

For a = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If ActiveSheet.Cells(a, 1).Value = "ACHCAMERIGROUP M" Then
        ActiveSheet.Rows(a + 1).Insert
        a = a + 1
    End If
Next a

End Sub

[JBeaucaire]

Change the code to insert at "a - 1" instead of "a + 1".

[Ferdinand]

Hi,

Thanks for the quick reply, but unfortunately it didn't work.

1st attempt --> changed both a + 1 into a - 1
result: ca. 6000 lines added and one line inserted one row below the needed row (caused by the a-1 ?)

2nd attempt --> changed the final a +1 into a - 1 in the code
result: excel is adding empty rows from the row with correct argument untill limit of file is reached.

[Ferdinand]

So, maybe a new code?

If this would be my column in excel ....
A
A
A
B
A
A
A

... i want to have an empy row inserted above each B
In other wors, the command 'insert row' should be made in the row where the B is located.

However, I have the feeling that after inserting one row (above) the found value 'B', the new value 'B' will be the one previous found and thus adding loads of empty rows.

So, after adding the row, the code should be programmed that it skips an extra row to continue the search without bouncing on the same argument again.

Does that makes sence?

Ferdinand.

[JBeaucaire]

Give this a try:

Option Explicit

Sub InsertRows()
Dim MyVal   As String
Dim MyCol   As Range
Dim vFIND   As Range
Dim vFIRST  As Range

MyVal = Application.InputBox("String to insert rows above", Type:=2)
If MyVal = "False" Then Exit Sub

Set MyCol = Application.InputBox("Highlight a column to search", Type:=8)
On Error Resume Next
Set vFIND = MyCol.Find(MyVal, MyCol.Cells(1), xlValues, xlWhole, xlByRows, xlNext, False)

    If Not vFIND Is Nothing Then
        Set vFIRST = vFIND
        Do
            vFIND.EntireRow.Insert xlShiftDown
            Set vFIND = MyCol.FindNext(vFIND.Offset(1))
        Loop Until vFIND.Address = vFIRST.Address
    Else
        MsgBox "Search string not found in the specified column." & vbLf & "No rows added."
    End If

Set MyCol = Nothing
Set vFirst = Nothing
Set vFind = Nothing
End Sub

[Ferdinand]

Thanks for the help. It is working now, and quite fancy I must say.
'please select string' and 'please select row'. Superb!

Thanks again.

Ferdinand

[JBeaucaire]

Ferdinand, I just noticed this was someone else's thread. Next time be sure to start a thread of your own, as per the Forum Rules. Thanks.

[hemaveera]

could any one help me how to insert a new row between two bold cell values. ex: insert a new row if values of b1 and b2 are bold and this implies to the whole row.

[arlu1201]

Hemaveera,

Welcome to the Forum, unfortunately:

Your post does not comply with Rule 2 of our Forum RULES. Don't post a question in the thread of another member -- start your own thread. If you feel it's particularly relevant, provide a link to the other thread. It makes sense to have a new thread for your question because a thread with numerous replies can be off putting & difficult to pick out relevant replies.