Use VBA to add lines to multiple tables

[The Doctor]

I found another topic that is providing a formula that I really like. Which can be found here http://chandoo.org/forums/topic/automatically-insert-row-into-table, the script provided is great but I need it to go one step further, I have 2 tables on same sheet that may need expansion. I can use the VBA with the named ranges on either one with success, but I'm not able to wrap my head around how to do both.


My expense report, and sad attempt at trying to modify the script from the other post can be found:


https://www.dropbox.com/s/3bv2ax3b3jzknfm/Expense%20Report%20V2.xlsm


and I always appreciate the help of the ninja squads here at Chandoo.org

 

[Luke M]

Another thread that might get you close is here:

http://chandoo.org/forums/topic/insert-row-in-tables-multiple-sheets-excel-2010


Doesn't directly apply, but should be similar in principle.

 

[SirJB7]

Hi, The Doctor!


Give a look at this file:

https://dl.dropboxusercontent.com/u/60558749/Use%20VBA%20to%20add%20lines%20to%20multiple%20tables%20-%20Expense%20Report%20V2%20%28for%20The%20Doctor%20at%20chandoo.org%29.xlsm


I updated and adjusted my the worksheet's change event code from my uploaded file in your quoted topic to meet the requirements you explained, resulting in this code:

-----

[pre]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' constants
Const ksNonOverwritableDataStart1 = "NonOverwritableDataStart1"
Const ksNonOverwritabledatastart2 = "nonoverwritabledatastart2"
Const ksTable1 = "Table1"
Const ksTable2 = "Table2"
' declarations
Dim rng1 As Range, rng2 As Range, rngT As Range
Dim bOk As Boolean
' start
Set rng1 = Range(ksNonOverwritableDataStart1)
Set rng2 = Range(ksNonOverwritabledatastart2)
bOk = False
If Not Application.Intersect(Target, rng1.Offset(-1, 0)) Is Nothing Then
If Target.Cells.Count > 1 Or _
Target.Cells(1, 1).Value = "" Then GoTo Worksheet_Change_Exit
bOk = True
Set rngT = Range(ksTable1)
End If
If Not Application.Intersect(Target, rng2.Offset(-1, 0)) Is Nothing Then
If Target.Cells.Count > 1 Or _
Target.Cells(1, 1).Value = "" Then GoTo Worksheet_Change_Exit
bOk = True
Set rngT = Range(ksTable2)
End If
If Not bOk Then GoTo Worksheet_Change_Exit
' process
Application.EnableEvents = False
With rngT
.Rows(.Rows.Count).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(.Rows.Count).EntireRow.Copy .Rows(.Rows.Count - 1)
.Cells(.Rows.Count, 1).ClearContents
.Rows(.Rows.Count - 2).EntireRow.Copy
.Rows(.Rows.Count - 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Cells(.Rows.Count - 1, 1).Select
Application.CutCopyMode = False
End With
Set rngT = Nothing
Application.EnableEvents = True
' end
Worksheet_Change_Exit:
Set rng2 = Nothing
Set rng1 = Nothing
End Sub

[/pre]
-----


I had to adjust your named ranges reference ksNonOverwritableDataStart 1&2 to the next cell in column A following the actual tables. I also renamed your tables from Table2 & Table3 to seldom Table1 & Table2 (just cosmetic).


Just advise if any issue.


Regards!

 

[The Doctor]

Works like a dream SirJB7. I appreciate your help and guidance in using the forum.


One thing I noticed while testing it, when the copy & paste by dragging feature (not sure what that's called, sorry) is used to fill the date column the extra lines don't spawn. It happens on both tables, so I'm not sure if it is the way the named range reads data pasted this way or what would cause it. I don't know how many people will try to paste dates in this way, so it may not be a big issue, but I'm curious about the behavior.

 

[SirJB7]

Hi, The Doctor!


Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.


Regarding drag&drop or copy&paste features I'm sorry but they're out of the scope of this solution as the worksheet change event is only triggered when a cell is updated by keyboard entries (either ending it with Enter or arrows or clicking with the mouse on another cell or region).


Regards!