Inserting blank row when data is entered in specific cell.

[Livin404]

Greetings, I have data entered into a workbook beginning on A16. Row 15 is a Header row. Once the user selects an item from the drop box J16 I would like a new line inserted for A16. I don't want the line to use Row 15's format. I made an attempt with the VBA below, but nothing seemed to happen. There are about 5 choices to choose from in J16 which is why I used <>. Thank you.

Sub InsertBlankRowsBasedOnCellValue()
    Dim Col As Variant
    Dim BlankRows As Long
    Dim LastRow As Long
    Dim R As Long
    Dim StartRow As Long

        Col = "J"
        StartRow = 16
        BlankRows = 1

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

            Application.ScreenUpdating = False

            With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) <> "" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
End Sub

 

[mumps]

It looks like you have a drop down not just in cell J16 but down the column and you want to insert a blank row below each row where column J is not blank. Is this correct? The macro you posted would add a blank row each time you run the macro resulting in multiple blank rows. I don't think that is what you want. You want only one blank row inserted when a selection is made in column J. Is this correct?