Macro for inserting row after last condition in a certain cell with formula

[CisaBP]

Hi,

I'm after a macro that can insert a row after the last cell containing certain text. For example in column D I have -

Apple
Apple
Apple
Apple
Banana
Banana
Banana
Banana
Banana
Carrot
Carrot

I'm after seperate macros to insert a row, which copies the formulas and formatting from above or below after the last Apple in column D. I'm after a seperate macro for each possiblity and will make buttons for people to select which option they need the row after. I need it to paste the formula and formatting from above, ideally leaving the other cells blank so it is obvious which row is new. There are drop down options in columns E & F and a lookup formula in G. The other cells are just data.

I had the following but it inserted a row after every single "Apple" and I just want it after the last.


Sub BlankLine()

Dim Col As Variant
Dim BlankRows AsLong
Dim LastRow AsLong
Dim R As Long
Dim StartRow AsLong

Col ="D"
StartRow = 1
BlankRows = 1

LastRow =Cells(Rows.Count, Col).End(xlUp).Row

Application.ScreenUpdating= False

WithActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) = "Apple" Then
.Cells(R + 1, Col).EntireRow.Insert shift:=xlDown
End If
Next R
End With
Application.ScreenUpdating = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub


Thanks!

 

[JackDanIce]

Try:

Sub BlankLine_v1()
    
    Dim LR  As Long
    Dim x   As Long

    Application.ScreenUpdating = False
    
    With ActiveSheet
        LR = .Cells(.Rows.Count, 4).End(xlUp).Row
        
        For x = LR To 2 Step -1
            With .Cells(x, 4)
                If .Value = "Apple" Then
                    .Offset(1).EntireRow.Insert shift:=xlDown
                    Exit For
                End If
            End With
        Next x
    End With

    Application.ScreenUpdating = True
    
End Sub