Push down rows when rows added to table ..... how?????

[spydey]

I have a Table (Table1) in one of my sheets. Let's say it goes from A2:D45.

From A50:D60, I have some additional cells (range) being used for other items.

When I go to A46 and input something, the table increases by one row, now including the data input in A46. This is what I want it to do.

However, the empty space between the last row of the table and A50, has now decreased.

Eventually my table will extend down past A50, which will cause issues with the data I have in A50:D60.

How can I go about making it so that no matter how many rows my table extends. ... I will always have 5 rows of space between my table's last row, and the next used range (i.e. A50:D60)?

Essentially I want to ensure that things get "pushed down" each time a my table extends by a new row.

I was thinking it would have to be in VBA ..... something like: whenever the table is extended, count the number of blank rows between the last row of the table and the first row (down) which is not blank, if less than 5, add X number of rows between to always have 5 rows between the last row of the table and the first not blank row.

Thoughts? Ideas?

-Spydey

 

[igold]

I am sure this could be done much more elegantly, but I think it fulfills your requirement...

Code should put in worksheet module that has the table.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    Dim ws1 As Worksheet: Set ws1 = Worksheets("Sheet1")
    Dim tbl As ListObject: Set tbl = ws1.ListObjects("Table1")
    Dim ltblR As Long, ltblC As Long, ftblR As Long, ftblC As Long
    Dim rng As Range


    ltblR = tbl.ListRows.Item(tbl.ListRows.Count).Range.Row
    ltblC = tbl.ListColumns.Item(tbl.ListColumns.Count).Range.Column
    ftblR = tbl.ListRows.Item(1).Range.Row
    ftblC = tbl.ListColumns.Item(1).Range.Column
    Set rng = Range(Cells(ftblR, ftblC), Cells(ltblR, ltblC))
    Set rng = rng.Offset(1, 0)
    If Not Intersect(ActiveCell, rng) Is Nothing Then ActiveCell.EntireRow.Insert
    
End Sub

 

[igold]

With a little bit of testing, this is more better!

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim ws1 As Worksheet: Set ws1 = Worksheets("Sheet1")
    Dim tbl As ListObject: Set tbl = ws1.ListObjects("Table1")
    Dim ltblR As Long, ltblC As Long, ftblR As Long, ftblC As Long
    Dim rng As Range


    ltblR = tbl.ListRows.Item(tbl.ListRows.Count).Range.Row
    ltblC = tbl.ListColumns.Item(tbl.ListColumns.Count).Range.Column
    ftblR = tbl.ListRows.Item(1).Range.Row
    ftblC = tbl.ListColumns.Item(1).Range.Column
    Set rng = Range(Cells(ltblR, ftblC), Cells(ltblR, ltblC))
    Set rng = rng.Offset(1, 0)
    Application.EnableEvents = False
    If Not Intersect(ActiveCell, rng) Is Nothing Then ActiveCell.EntireRow.Insert
    Application.EnableEvents = True
    
End Sub

 

[Akuini]

Here's just another way:
Copy this macro to the sheet code module.

[FONT=lucida console][COLOR=Royalblue]Private[/COLOR] [COLOR=Royalblue]Sub[/COLOR] Worksheet_Change([COLOR=Royalblue]ByVal[/COLOR] Target [COLOR=Royalblue]As[/COLOR] Range)
[COLOR=Royalblue]With[/COLOR] ActiveSheet.ListObjects([COLOR=brown]"Table1"[/COLOR])
[COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] Intersect(Target, .ListRows(.Range.Rows.Count - [COLOR=crimson]1[/COLOR]).Range) [COLOR=Royalblue]Is[/COLOR] [COLOR=Royalblue]Nothing[/COLOR] [COLOR=Royalblue]Then[/COLOR]
    [COLOR=Royalblue]Dim[/COLOR] r [COLOR=Royalblue]As[/COLOR] Range
    [COLOR=Royalblue]Set[/COLOR] r = .Range.Offset(.Range.Rows.Count).Resize([COLOR=crimson]5[/COLOR], [COLOR=crimson]1[/COLOR])
    [COLOR=Royalblue]If[/COLOR] WorksheetFunction.CountA(r) > [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR]
    Application.EnableEvents = [COLOR=Royalblue]False[/COLOR]
        r.Cells([COLOR=crimson]2[/COLOR], [COLOR=crimson]1[/COLOR]).Resize(WorksheetFunction.CountA(r)).EntireRow.Insert
    Application.EnableEvents = [COLOR=Royalblue]True[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[spydey]

@igold

Thanks for the input. I appreciate it. I will have to give it a try here in a bit and let you know if I have any issues.

-Spydey

 

[igold]

I hope it works out for you. If not, perhaps Akuini's code will. Either way if you have issues...

 

[spydey]

@Akuini

The code looks great!!

I gave it a test run and adjusted a few things. It is almost flawless.

Here is what I changed:

Private Sub Worksheet_Change(ByVal Target As Range)
With ActiveSheet.ListObjects("tblDelays")
If Not Intersect(Target, .ListRows(.Range.Rows.Count - 1).Range) Is Nothing Then
    Dim r As Range
    Set r = .Range.Offset(.Range.Rows.Count).Resize(2, 1)
    
    With Range("tblDelays")
        With .Borders(xlEdgeTop)
                .LineStyle = xlDouble
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThick
        End With
        With .Borders(xlEdgeBottom)
                .LineStyle = xlDouble
                .ColorIndex = xlAutomatic
                .Weight = xlThick
        End With
        With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
        End With
    
    End With
    
    If WorksheetFunction.CountA(r) > 0 Then
    Application.EnableEvents = False
        r.Range(Row(.Resize(WorksheetFunction.CountA(r)).EntireRow.Insert
    Application.EnableEvents = True
    
    End If
End If

End With

End Sub

There is one small thing I was hoping to get your input on, if you don't mind.

The code

[COLOR=#333333][FONT='inherit']r.Cells([/FONT][/COLOR][COLOR=crimson][FONT='inherit']2[/FONT][/COLOR][COLOR=#333333][FONT='inherit'], [/FONT][/COLOR][COLOR=crimson][FONT='inherit']1[/FONT][/COLOR][COLOR=#333333][FONT='inherit']).Resize(WorksheetFunction.CountA(r)).EntireRow.Insert[/FONT][/COLOR]

is inserting an entire row.

How can we adjust it so that it only inserts a row the same width as my table, not an entire row?

My table has a width of A:k. I was thinking something like .Insert xlShiftDown, but wasn't exactly sure on how to make it work with the code you already provided for the width I need.

Thoughts? Ideas?

Thanks again for your help!

-Spydey

 

[spydey]

I hope it works out for you. If not, perhaps Akuini's code will. Either way if you have issues...

Thanks @igold.

Perhaps you might have some input for my question I posed to Akuini.

I need to insert a row only the width of my table, not an entire row.

Thoughts?

-Spydey

 

[igold]

I am running out the door but that is completely doable.

You may want to check out this site as a good reference to working with tables...

https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables

Your answer is in there...

 

[spydey]

@igold

Awesome!! Thanks. I will check it out.

-Spydey