inserting row above when cell contains certain text

[ctrl+alt_del]

Trying to create a macro to insert a row above any cell that contains the word ' OPEN '. Any help would be appreciated. Thanks.

 

[btadams]

Welcome to the Board! How about this:

Sub FindAll()
Dim c As Range

    With Selection
        Set c = .Find(What:="open", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
        If Not c Is Nothing Then
            firstAddress = c.Offset(1, 0).Address
            Do While Not c Is Nothing And c.Address <> firstAddress
                c.EntireRow.Insert
                Set c = .FindNext(c)
            Loop
        End If
    End With
End Sub

 

[ctrl+alt_del]

thanks much, btadams

I should explain that the cells will contain other text, in addition to " Open ". I ran the macro, and it inserted no rows, even though there are hundreds of cells in the 1800+ rows which contain the word " Open ". Does the line:

Set c = .Find(what:="open", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

need to be modified because the cells will have more words than just " Open " in them?

Thanks again!

 

[btadams]

Change LookAt:=xlWhole to LookAt:=xlPart

 

[ctrl+alt_del]

It still did not add any empty rows. Here is an example of the data:
I have over 1800 rows, so a find and manual insert is going to be a pain. Also, some addresses have more rows of data than others, even though that isn't shown in the sample, so I can't just tell the macro add a blank row every X lines.

Thanks yet again....

XYZ Electrical Open
XYZ Electrical, ABC
P.O. Box 387
townname, ST 13245
Persons name
ABCDEFGHIJK Open
ABCDEFGHIJK, Inc.
1234-5 Street Name
townname, ST 12345
Persons Name
QWERTY Co. Open
QWERTY Co.
123 North Street
Townname, ST 12345
Persons Name

 

[btadams]

I pasted your example into a worksheet and it inserted empty rows, in fact it got stuck in an endless loop because I hadn't thought about "open" being in the first cell of the selection. Try this:

Sub FindAll()
Dim c As Range

    With Selection
        Set c = .Find(What:="open", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
        If Not c Is Nothing Then
            firstAddress = c.Offset(1, 0).Address
            Do While Not c Is Nothing And c.Address <> firstAddress
                If c.Address = "$A$1" Then firstAddress = Range(firstAddress).Offset(1, 0).Address
                c.EntireRow.Insert
                Set c = .FindNext(c)
                MsgBox c.Address
            Loop
        End If
    End With
End Sub

 

[ctrl+alt_del]

btadams, your last solution did work. My problem was I misinterpreted your lower case L as a Bar | when I read your updated macro off the the web page, and entered it into the VBA screen. I verified all the characters were correct, and it ran perfectly. Much appreciated!

(of course, now the ditz that asked for this in the first place tells me she gave me the wrong data, so I'll need to see if this macro will apply to the updated worksheet she's sending me.... !@#$%!!!!!)