madvogue29
New Member
- Joined
- Aug 28, 2020
- Messages
- 32
- Office Version
- 365
- Platform
- 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.
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