any VBA wizz kids out there?

[Paul]

Hi All,

I am sure this has been asked before, but please help as I am going around
in circles! Does anyone have any code / know where I can find code which
will achieve the following?

1) Add a row at the bottom of a table (Table 1), ensuring formatting and
formula are copied down. If the cell above has an inputted data, then then
corresponding cell below needs to be blank.
2) When a user adds a row (by clicking a button say) to Table 1, an
additional row at the bottom of a different table (Table 2) automatically
appears. Table 2 is on another worksheet but within the same excel document.
Again, all the formula, formatting etc needs to be copied down into this new
row in Table 2.

I am sure that there is a simple solution, and sorry if this is a common
question - like I said, going around in circles!

any help would be welcome.

thanks

Paul

 

[JLatham]

There's probably one out here somewhere, but until he or she comes along I'll
try to substitute. Since you didn't give us information about the sheets
(like their names) or the tables (as what columns they occupy and how to tell
what the current last row in each is), I worked up a somewhat generic process
that you will need to change some Const values in to get it to work with your
sheets and table layouts. Note that the sheets can't be protected when you
run this code.

Sub AddTableRows()
'change these Const values to
'describe your two sheets and
'the tables on them.

'define the first
'sheet and table
Const t1SheetName = "Sheet1"
'first/left-most column in the table
Const t1FirstCol = "B"
'last/right-most column in the table
Const t1LastCol = "E"
'column in the table that will
'ALWAYS have some data in it
Const t1KeyCol = "C"
'define the second
'sheet and table
Const t2SheetName = "Sheet2"
'first/left-most column in the table
Const t2FirstCol = "D"
'last/right-most column in the table
Const t2LastCol = "G"
'column in the table that will
'ALWAYS have some data in it
Const t2KeyCol = "G"
'
'variables needed
Dim tWS As Worksheet
Dim tLastRow As Long
Dim tOldLastRow As Range
Dim tNewLastRow As Range
Dim anyNewCell As Range

'work on the first table
Set tWS = ThisWorkbook.Worksheets(t1SheetName)
tLastRow = tWS.Range(t1KeyCol & Rows.Count).End(xlUp).Row
Set tOldLastRow = tWS.Range(t1FirstCol & tLastRow & ":" & _
t1LastCol & tLastRow)
Set tNewLastRow = tWS.Range(t1FirstCol & tLastRow + 1 & ":" & _
t1LastCol & tLastRow + 1)
tOldLastRow.Copy

tNewLastRow.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
tNewLastRow.PasteSpecial Paste:=xlPasteFormulas, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
For Each anyNewCell In tNewLastRow
If anyNewCell.HasFormula = False Then
anyNewCell.ClearContents
End If
Next

'process the 2nd table
Set tWS = ThisWorkbook.Worksheets(t2SheetName)
tLastRow = tWS.Range(t2KeyCol & Rows.Count).End(xlUp).Row
Set tOldLastRow = tWS.Range(t2FirstCol & tLastRow & ":" & _
t2LastCol & tLastRow)
Set tNewLastRow = tWS.Range(t2FirstCol & tLastRow + 1 & ":" & _
t2LastCol & tLastRow + 1)
tOldLastRow.Copy

tNewLastRow.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
tNewLastRow.PasteSpecial Paste:=xlPasteFormulas, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
For Each anyNewCell In tNewLastRow
If anyNewCell.HasFormula = False Then
anyNewCell.ClearContents
End If
Next

'housekeeping
Set tNewLastRow = Nothing
Set tOldLastRow = Nothing
Set tWS = Nothing

End Sub