insert rows in table above specific cell value

[Art3mis]

Can someone help me create a macro that will insert a row on two separate tabs at the same time? The rows are not in the same location, therefore I would like to have them inserted in the row above a specific cell value.
For instance, the first tab should have a row inserted above the word Seller and the second tab should have a row inserted above the word buyer. I need this to all be in one macro. Is this possible?

 

[JoeMo]

This assumes the two tabs are named Sheet1 (look for Seller) and Sheet2 (look for Buyer) - change tab names to suit. Also assumes the search words are not part of a longer string.

Sub InsertIf()
Const S As String = "Seller": Const B As String = "buyer"
Dim Fnd1 As Range, Fnd2 As Range, fAdr As String, Ins As Range
Application.ScreenUpdating = False
With Sheets("Sheet1")   'change sheet name to suit. Looking for seller
    Set Fnd1 = .Cells.Find(S, , xlValues, xlWhole, , xlPrevious, False)
    If Not Fnd1 Is Nothing Then
        fAdr = Fnd1.Address
        Set Ins = Fnd1
    End If
    Do
        Set Fnd1 = .Cells.FindNext(Fnd1)
        If Fnd1 Is Nothing Then Exit Do
        If Fnd1.Address = fAdr Then Exit Do
        Set Ins = Union(Ins, Fnd1)
    Loop
    If Not Ins Is Nothing Then
        Ins.EntireRow.Insert
    Else
        MsgBox S & " not found on Sheet1"
    End If
End With
With Sheets("Sheet2")   'change sheet name to suit. Looking for buyer
    Set Fnd2 = .Cells.Find(B, , xlValues, xlWhole, , xlPrevious, False)
    If Not Fnd2 Is Nothing Then
        fAdr = Fnd2.Address
        Set Ins = Fnd2
    End If
    Do
        Set Fnd2 = .Cells.FindNext(Fnd2)
        If Fnd2 Is Nothing Then Exit Do
        If Fnd2.Address = fAdr Then Exit Do
        Set Ins = Union(Ins, Fnd2)
    Loop
    If Not Ins Is Nothing Then
        Ins.EntireRow.Insert
    Else
        MsgBox B & " not found on Sheet2"
    End If
End With
Application.ScreenUpdating = True
End Sub

 

[Art3mis]

Thanks a lot JoeMo!! This helps me a ton. Would there be a way to add to this macro to include that the inserted row on the second tab will automatically autofill with the formula of the row above. Or alternatively autofill with the same data as the row inserted on the first tab?

 

[JoeMo]

You are welcome - thanks for the reply. I will look into your new request to autofill when time permits.

 

[JoeMo]

Here's a modification that is intended "to include that the inserted row on the second tab will automatically autofill with the formula of the row above" per your new request - lightly tested so may need some tweaking as I have no idea what your data layout looks like.

Sub InsertIf()
Const S As String = "Seller": Const B As String = "buyer"
Dim Fnd1 As Range, Fnd2 As Range, fAdr As String, Ins As Range, Rw As Range
Application.ScreenUpdating = False
With Sheets("Sheet1")   'change sheet name to suit. Looking for seller
    Set Fnd1 = .Cells.Find(S, , xlValues, xlWhole, , xlPrevious, False)
    If Not Fnd1 Is Nothing Then
        fAdr = Fnd1.Address
        Set Ins = Fnd1
    End If
    Do
        Set Fnd1 = .Cells.FindNext(Fnd1)
        If Fnd1 Is Nothing Then Exit Do
        If Fnd1.Address = fAdr Then Exit Do
        Set Ins = Union(Ins, Fnd1)
    Loop
    If Not Ins Is Nothing Then
        Ins.EntireRow.Insert
    Else
        MsgBox S & " not found on Sheet1"
    End If
End With
With Sheets("Sheet2")   'change sheet name to suit. Looking for buyer
    Set Fnd2 = .Cells.Find(B, , xlValues, xlWhole, , xlPrevious, False)
    If Not Fnd2 Is Nothing Then
        fAdr = Fnd2.Address
        Set Ins = Fnd2
    End If
    Do
        Set Fnd2 = .Cells.FindNext(Fnd2)
        If Fnd2 Is Nothing Then Exit Do
        If Fnd2.Address = fAdr Then Exit Do
        Set Ins = Union(Ins, Fnd2)
    Loop
    If Not Ins Is Nothing Then
        Ins.EntireRow.Insert
        For Each Rw In Ins.EntireRow.Rows
            Rw.Offset(-2, 0).Resize(2).FillDown
        Next Rw
    Else
        MsgBox B & " not found on Sheet2"
    End If
End With
Application.ScreenUpdating = True
End Sub

 

[Art3mis]

This is perfect! Thanks a lot for your time and help. Much appreciated!

 

[JoeMo]

You are welcome - thanks for the reply.

 

[Art3mis]

Is there a way to format this macro so that the inserted line will be two lines up from the text instead of one- in this case the words seller and buyer?

 

[JoeMo]

Change this:

Ins.EntireRow
to this:
Ins.offset(-1,0).EntireRow

In the three places where it occurs in the code.

 

[Art3mis]

This is great! Thank you! If I did not yet exceed my limit on questions... Is there a way to include in the macro that the formatting from the row above should pull down to the newly inserted line?