VBA - Adding extra rows

[smtsun]

Help!!
I have been trying for a number of days to come up with a solution to a problem I am faced with. The job can easily be accomplished manually but I would a macro to do the job if possible.

I have a list of 100 items (from row 3 to row 102) with totals on row 103. I would like to add a number or row based on a cell value, e.g. cell M1 between rows 101 and 102 so not to affect the totals on row 103. When inserting the new rows, I would like the formulae from row 101 (columns F, G and H) to be copied onto the new rows.

Any help is much appreciated.

 

[sijpie]

let me refrase:

you have a list of items with a totals row at the bottom
you want to insert a few rows at the bottom above the totals row

I am assuming you want the totals row to include the newly added rows.

Question:
Why are you not using a Table, with a totals row? Then when you insert rows at the bottom the totals row is automatically updated, plus the formulas are automatically copied.

Let me know if that appeals to you. Both methods can be easily coded, but the coding is slightly different for tables.

 

[My Aswer Is This]

Here is a solution I use.

Assuming your using a tabel

Add a Totals row to your table and set the formulas the way you want.

Now copy the Totals row and paste it where you want. Preferable above the table range
Now go back and delete the Totals row. Or turn off Totals row.
Now you can just keep entering more values to your table which extends the table range without needing to insert more rows.


The place where you copied the Totals row will continue to update as you enter more data in more table rows.

 

[smtsun]

let me refrase:

you have a list of items with a totals row at the bottom
you want to insert a few rows at the bottom above the totals row

I am assuming you want the totals row to include the newly added rows.

Question:
Why are you not using a Table, with a totals row? Then when you insert rows at the bottom the totals row is automatically updated, plus the formulas are automatically copied.

Let me know if that appeals to you. Both methods can be easily coded, but the coding is slightly different for tables.

Hi and thank you for getting back to me.

The table is made up of 8 columns and already contains 52 rows (1 row for headings, 10 rows of data and the last row for totals as shown below). There are times when extra rows are needed and would like, lets say, a button on the same row as "Project GDV" that I can use to either add any number of rows or deleting the added rows without affecting the totals from Subtotal of NIFA to Project GDV.

The other item that I did not mention is that this table is linked to another worksheet and hope that there is some macro to update the other worksheet with the number of added rows or deleted rows.

Your assistance is much appreciated.
SMT

 

[sijpie]

smtsun

the code below will do the trick. TO make it easier, there is one thing you need to do BEFORE running the code:
manually add a row to the bottom of the table (below Plot 10 in your example, see my screenshot). make sure the leftmost cell is empty.
Then hide this row.

Now copy the code into a macro module, make two buttons and link the buttons to each of the two macros.

Option Explicit

Sub InsertRowInTable()
    'Insert row to bottom of table, shift totals down
    ' Assumes that there is an empty, hidden row in the table
    
    Dim rBot As Range
    
    'Find table heading
    Set rBot = Columns("E").Find("Plot Info")
    If rBot Is Nothing Then
        MsgBox "Cannot find table heading 'Plot Info'. Please check.", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    'find visible bottom of the table
    Set rBot = rBot.End(xlDown)
    
    'Insert the new row
    rBot.Offset(1, 0).Resize(1, 8).Insert shift:=xlShiftDown
    'copy formula in m2 column
    rBot.Offset(1, 5).Formula = rBot.Offset(0, 5).Formula
    
    Set rBot = Nothing
End Sub


Sub RemoveRowfromTable()
    'Removes current table from table
    
    Dim rTable As Range
    
    'Find table heading
    Set rTable = Columns("E").Find("Plot Info")
    If rTable Is Nothing Then
        MsgBox "Cannot find table heading 'Plot Info'. Please check.", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    ' Check that a cell in the table (not the header row) has been selected
    If ActiveCell.Row > rTable.Row And Not Intersect(ActiveCell, rTable.CurrentRegion) Is Nothing Then
        rTable.Offset(ActiveCell.Row - rTable.Row, 0).Resize(1, 8).Delete shift:=xlShiftUp
    Else
        MsgBox "Select a cell in the table row you want " & vbCrLf & _
               "to remove. Caution: this cannot be undone", vbInformation + vbOKOnly
    End If
    
End Sub

 

[smtsun]

sijpie,

Thank you very much. I do not have the time now to work on this but will do over the week end.

SMT