Add rows to a table when you fill the last row?

madvogue29

New Member
Joined
Aug 28, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Hi all I am looking for a dynamic solution that adds rows to my tables on a sheet when it is almost full.

I am using this (Code below) where range B2 and E2 keep track of the last cell in each table.
I am going to work with script that generates new tables dynamically and this solution wont work. Can someone please help.



VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells, KeyCells2, KeyCells3 As Range
   
    Dim x, i, a, b As Integer
   
    i = Sheets("Sheet2").Range("B2").Value
    x = i - 1
    a = Sheets("Sheet2").Range("E2").Value
    b = a - 1

' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    'Set KeyCells = Sheets("Sheet1").Cells(x, 2)
    Set KeyCells = Sheets("Sheet1").Cells(x, 2)
    Set KeyCells2 = Sheets("Sheet1").Cells(b, 2)
    Set KeyCells3 = Sheets("Sheet1").Range("B2:L28")

'MsgBox "Cell " & KeyCells.Address

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
'MsgBox "trigger 1"
' Display a message when one of the designated cells has been
        ' changed.
        ' Place your code here.
        Call Module1.AddRows
        MsgBox Target.Value & " has been added."
     
       
ElseIf Not Application.Intersect(KeyCells2, Range(Target.Address)) _
           Is Nothing Then
'MsgBox "trigger 2"
' Display a message when one of the designated cells has been
        ' changed.
       
        ' Place your code here.
        Call Module2.AddRows2
       
       
ElseIf Not Application.Intersect(KeyCells3, Range(Target.Address)) _
           Is Nothing Then
'MsgBox "trigger 2"
' Display a message when one of the designated cells has been
        ' changed.
       
        ' Place your code here.
        MsgBox "Cell " & Target.Address & " has changed to " & Target.Value
       


End If

End Sub
VBA Code:
Sub AddRows2()
Dim i, x As Integer
Dim lastRow, checkRow As Range
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject



i = Sheets("Sheet2").Range("E2").Value
x = i - 1
Sheets("Sheet1").Activate
Set tbl = ActiveSheet.ListObjects("Table13")

Set lastRow = ws.Cells(i, 2)
Set checkRow = ws.Cells(x, 2)


If Not IsEmpty(checkRow.Value) Then

tbl.ListRows.Add AlwaysInsert:=True
tbl.ListRows.Add AlwaysInsert:=True
tbl.ListRows.Add AlwaysInsert:=True
tbl.ListRows.Add AlwaysInsert:=True
tbl.ListRows.Add AlwaysInsert:=True

i = i + 5
x = i - 1
Sheets("Sheet2").Range("E2").Value = i
Sheets("Sheet2").Range("F2").Value = x
MsgBox x
Exit Sub

Else

End If

Exit Sub
 

Some videos you may like

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,049
Office Version
  1. 2010
Platform
  1. Windows
No need to keep track of things on a separate sheet.
Try something along the lines of this to count the blanks at the bottom of the first table column and add more rows if needed.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim x As Long, i As Long
Dim hdr_row As Long, last_row As Long, lastdata_row As Long
Dim tbl As ListObject

Set tbl = ActiveSheet.ListObjects(1)    '<-- first table on sheet

If Not Intersect(Target, tbl.Range) Is Nothing Then
    With tbl
        'the header row
        hdr_row = .HeaderRowRange.Cells(1).Row
        'last row of table
        last_row = .ListRows.Count + hdr_row
        'last row with data in listcolumn(1) <-- first table column
        lastdata_row = .DataBodyRange.Cells(.ListRows.Count, 1).End(xlUp).Row
        'number of existing blank rows
        x = last_row - lastdata_row
        'if less than 3 blanks add another 5
        If x < 3 Then
            Application.EnableEvents = False
            For i = 1 To 5
                .ListRows.Add
            Next i
            Application.EnableEvents = True
        End If
    End With
End If
End Sub
 

madvogue29

New Member
Joined
Aug 28, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
No need to keep track of things on a separate sheet.
Try something along the lines of this to count the blanks at the bottom of the first table column and add more rows if needed.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim x As Long, i As Long
Dim hdr_row As Long, last_row As Long, lastdata_row As Long
Dim tbl As ListObject

Set tbl = ActiveSheet.ListObjects(1)    '<-- first table on sheet

If Not Intersect(Target, tbl.Range) Is Nothing Then
    With tbl
        'the header row
        hdr_row = .HeaderRowRange.Cells(1).Row
        'last row of table
        last_row = .ListRows.Count + hdr_row
        'last row with data in listcolumn(1) <-- first table column
        lastdata_row = .DataBodyRange.Cells(.ListRows.Count, 1).End(xlUp).Row
        'number of existing blank rows
        x = last_row - lastdata_row
        'if less than 3 blanks add another 5
        If x < 3 Then
            Application.EnableEvents = False
            For i = 1 To 5
                .ListRows.Add
            Next i
            Application.EnableEvents = True
        End If
    End With
End If
End Sub


Thanks for the response! This is for the first table in the sheet. I will be adding tables using a script. So in a months time there may be 50 tables on the sheet. How can I modify this to update all tables on the sheet when it is almost full.

Is there a way that does ActiveSheet.ListObjects.All ??
 

madvogue29

New Member
Joined
Aug 28, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Actually I added a loop and it worked ! Thank you NoSparks for all your help. I really appreciate it. Attached code below :


Private Sub Worksheet_Change(ByVal Target As Range)

Dim x As Long, i As Long
Dim hdr_row As Long, last_row As Long, lastdata_row As Long
Dim tbl As ListObject

'Loop through each sheet and table in the workbook
For Each tbl In ActiveSheet.ListObjects

'Do something to all the tables...


If Not Intersect(Target, tbl.Range) Is Nothing Then
With tbl
'the header row
hdr_row = .HeaderRowRange.Cells(1).Row
'last row of table
last_row = .ListRows.Count + hdr_row
'last row with data in listcolumn(1) <-- first table column
lastdata_row = .DataBodyRange.Cells(.ListRows.Count, 1).End(xlUp).Row
'number of existing blank rows
x = last_row - lastdata_row
'if less than 3 blanks add another 5
If x < 3 Then
Application.EnableEvents = False
For i = 1 To 5
.ListRows.Add
Next i
Application.EnableEvents = True
End If
End With
End If

Next tbl
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,753
Messages
5,626,667
Members
416,199
Latest member
Gautamsunil

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top