Enter lines below a specific line

[dpaton05]

I have code to enter new lines in a table at the bottom. I might have 5 lines already in the table and I want to enter a line/s in the middle at row 4. I can select row 4 and press add lines but it will still add the lines to the bottom. What do I need to change in my code so that I can select the row and have the lines entered below it?

Sub Addlines()
    Application.EnableEvents = False
    'ActiveSheet.Unprotect Password:="CSSadmin"
    Dim ws As Worksheet, x As Long, tbl As ListObject, n As Long

        On Error GoTo cancelled:
        n = InputBox("How many lines would you like to add ?")
        Set ws = ActiveSheet
        Set tbl = ws.ListObjects("CSS_quote")
        'add 5 rows
        For x = 1 To n
            'add a row at the end of the table
            tbl.ListRows.Add
           ' ActiveSheet.ListObjects("CSS_quote").DataBodyRange.Columns(12).Value = 1 - 0.1 * ActiveSheet.chkIncrease.Value
            Range("A:A").NumberFormat = "dd/mm/yyyy"
        Next x
    tbl.Range.Cells(tbl.ListRows.Count - n + 2, 1).Select
    'ActiveSheet.Protect Password:=""
    Application.EnableEvents = True
cancelled:
    Exit Sub
End Sub

 

[jmacleary]

Hi there. Try this (you need the activecell to be in the row where you want to insert after):

Sub Addlines()
    Application.EnableEvents = False
    'ActiveSheet.Unprotect Password:="CSSadmin"
    Dim ws As Worksheet, x As Long, tbl As ListObject, n As Long

        On Error GoTo cancelled:
        n = InputBox("How many lines would you like to add ?")
        Set ws = ActiveSheet
        Set tbl = ws.ListObjects("CSS_quote")
            'add n rows after the active cell
            ActiveCell.EntireRow.Offset(1).Resize(n).Insert Shift:=xlShiftDown
            Range("A:A").NumberFormat = "dd/mm/yyyy"
    tbl.Range.Cells(tbl.ListRows.Count - n + 2, 1).Select
    'ActiveSheet.Protect Password:=""
    Application.EnableEvents = True
cancelled:
    Exit Sub
End Sub