Add a row below with copied formatting and (selective) data from the row above

Question

Hello everyone,

I'm trying to do something fairly complex (for me at least, may be not so complex for most of you):

Please have a look at the attached dummy spreadsheet image below.

As per attached spreadsheet you can use rows '3' to '14' as an example of how it's going to look like.

What I want to automate is; in case there are more items in the category I want to be able to press a button, a shortcut, or some kind of easy function that will automatically do the following:

Note: for purpose of easily explaining I will be assuming we are running the function whilst cell 'B15' is selected.

1. Create a new row below.
2. The new row ('16') will copy the formatting of the row above (Same borders and cell types)
3. Place zeros in columns 'E' and 'F' [Optional step]
4. Will copy the data/formula from the row above, in columns 'A', and 'G'.
5. The Subtotal formula (now in cell 'G17') will be updated to include the data in column 'G' of the new row ('G16')

I hope I sufficiently explained this. Hope someone can help me out here. I've been racking my brain for the last few days about this. And current forum post although some are useful, I don't have sufficient knowledge of excel to make use of it correctly.

If this is a bit hard/complex as a free community question, could someone please refer me to a service where they can do this for me (not free).

PS. Prefer to do this without use of macros, but if impossible than macros it is.

Many thanks

Answer 1

Be careful with the .Find command line. This forum likes to insert blank lines into code. There should be no blank lines in the 3line find command.

Option Explicit

Sub insert_item_row()

    Dim rw As Long, fnd As Range, addr As String

    rw = Selection.Cells(1).Row

    With ActiveSheet

        'check if this is an Item row

        If LCase(.Cells(rw, "D")) = "sub total" Then

            'selection is not an item row

            MsgBox "this sub procedure is not designed to create subtotal rows" & Chr(10) & "choose an item row", vbOKOnly + vbCritical, "bad choice"

            Exit Sub

        End If

        'copy, shift down, then insert

        .Range(.Cells(rw, "A"), .Cells(rw, "H")).Copy

        .Cells(rw + 1, "A").Insert Shift:=xlDown

        'clear some cell content

        Union(.Range(.Cells(rw + 1, "B"), .Cells(rw + 1, "D")), Cells(rw + 1, "H")).ClearContents

        'zero some cell values

        .Range(.Cells(rw + 1, "E"), .Cells(rw + 1, "F")) = 0

        'correct column A formula

        .Cells(rw, "A").Resize(2, 1).FillDown

        'repair all sections' subtotal row formula

        With .Range("D:D")

            'find first 'sub total'

            'temporaily disable error handling

            On Error Resume Next

            Set fnd = .Find(What:="sub total", after:=.Cells(1), LookIn:=xlFormulas, _

                            LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False, _

                            SearchOrder:=xlByRows, SearchDirection:=xlNext)

            'restore error handling

            On Error GoTo 0

            'was one found?

            If Not fnd Is Nothing Then

                'save first found item address

                addr = fnd.Address(0, 0)

                'loop through all 'sub total' rows correcting formulas

                Do

                    'assign correct formula to column G

                    fnd.Offset(0, 3).FormulaR1C1 = "=sum(R[-1]C:index(R3C:R[-1]C, iferror(match(""zzz"", R3C[-3]:R[-1]C[-3])+1, 1)))"

                    'look for another

                    Set fnd = .FindNext(after:=fnd)

                'continue until it loops back to the first

                Loop Until addr = fnd.Address(0, 0)

            End If

        End With

    End With

End Sub

Answer 2

The code looks for Sub Total (space included) in column D using the LookAt:=xlWhole argument. If you've padded that with spaces or non-breaking spaces or what-not then it cannot find the rows with Sub Total to correct.

If Sub Total is not in column D then maybe it should be. If it's in another column (e.g. B or C) with a lot of prefix spacing then change the code to look in whatever column it actually resides in and change the offset to point to column G from that column.

If you've actually typed in a bunch of spaces or for whatever reason the cell's value is not EXACTLY Sub Total then you could change that argument to LookAt:=xlPart but that could create more problems with other things where Sub Total is part of an item's description or something.

Suffice to say that the code looks in column D for Sub Total as the full cell's contents. If it cannot be found there, the code needs to be modified so it can find the rows with Sub Total.