automatically input formulas in table

[titit34]

Hello all,
I have huge quantities of data in different tables of the same kind.
These tables don't contain formulas but flat values. I would like to input automatically some formulas in order, when I update a data, to modify accordingly the related total cell.
The 3 questions are included in the image with an example.
Thank you for your time and your help !
Best regards.

exemple excel.jpg

[Kevin#]

Try this.
Assumes
-column headings in row1, with data continuous from row2
-subTotals and grandTotal in bold
-no blank rows

Sub InsertTotals()
    With ActiveSheet
        Dim lastRow As Long
        Dim subT As Double
        Dim r1 As Range, r2 As Range
        Dim subT_Formula As String
        lastRow = Range("A1").CurrentRegion.Rows.Count

        'total price formula
        For r = 2 To lastRow
            .Cells(r, 4).Formula = "=B" & r & "*C" & r
        Next r

        'grand total
        .Cells(lastRow, 4).Formula = "=SUM(D2:D" & lastRow - 1 & ")/2"
        .Cells(lastRow, 2).Formula = "=SUM(B2:B" & lastRow - 1 & ")/2"

        'intermediate sub-totals
        .Cells(2, 4).Select
        For r = 2 To lastRow - 1
            Set r1 = ActiveCell
                Do Until ActiveCell.Font.Bold = True
                    ActiveCell.Offset(1, 0).Select
                Loop
            Set r2 = ActiveCell.Offset(-1, 0)
            subT_Formula = "=sum(" & r1.Address(0, 0) & ":" & r2.Address(0, 0) & ")"
            ActiveCell.Formula = subT_Formula
            ActiveCell.Offset(1, 0).Select
            r = ActiveCell.Row
        Next r
    End With
End Sub

[titit34]

Thank you very much Kevin for your help ! I greatly appreciate it.
Indeed your syntax works well with the example I gave you (except with subtotal for quantity column but I could sort out this detail following your syntax). But for the real template I use, it is a bit more complex and I struggle a little bit. Maybe you can have a look to it..
https://www.sendspace.com/file/df339f
Warmest regards.

[Kevin#]

Can you attach your workbook to your reply.
Click on reply and
then click on "Go Advanced" and
then look below for "Manage Attachments"

[titit34]

Hello Kevin,

Please find the excel sheet attached.
Warmest regards.
Thierry

[Kevin#]

The attachment is very different from what you asked in post#01
1. columns are in a different sequence
2. 4 columns have now become 9 columns
3. discount column has been added
4. cell A1 previously was part of the table and now surrounded by blank cells
5. additional grand total at bottom of table

Several lines in the macro require amendments. Before I make those amendments can you clarify a few things:

Column headings - do they always appear in row7, starting in columnB. Can "A1" always be "B7"?

lastRow = Range("A1").CurrentRegion.Rows.Count

[CurrentRegion relies on having a table of continuous data to determine the last row - no blank rows or columns]

Discount column - in the attachment all values are zero. Is this ever used?
If not used - should the macro delete the column?
If it is used - please attach an example where there are values in discount column
[need to amend the calculation for total price to take account of discount if ever used]

"Total For Fruits" (in row18) - do these words always accompany the Fruit sub-total
[helpful in identifying where data finishes]

Final total - the grand total at the bottom of the sheet appears unnecessary - should the macro delete this?
[the only reason to retain this total would be for combined reporting of "Fruit" plus "non-Fruit" products]

[titit34]

Hello Kevin, I assume it is more complex than exposed in my first post..

To answer your questions:

-> "A1" is ALWAYS "B7". Table headings always start at B7.

-> Some datas include discount.
Indeed, discount should be included in the calculation as followed
On each row including datas, UNIT PRICE (column F) - 15% (example of discount rate) * Qty (column G) = TOTAL (column I)

-> "Total For Fruits" (in row18) do always accompany the Fruit sub-total

-> No need to delete the final total line in a macro

Thank you so much for your help!
Warmest regards.
Thierry

[Kevin#]

"If it is used - please attach an example where there are values in discount column"
I meant please attach a workbook with a valid discount example - when data dumped from elsewhere with %, can often come in as text - so want to make sure it works first time

thanks

[titit34]

Displaying discount cells as percentage in the macro would be perfect in the same format you will see in the attached worksheet.
Thank you Kevin !

[Kevin#]

This is the new code which needs running from the sheet to be modified.
Attached workbook contains sheet "Data", which is made up of values only.
To run the macro {CTRL} + t

Sub InsertTotals2()
    With ActiveSheet
        Dim lastRow As Long
        Dim subT As Double
        Dim r1 As Range, r2 As Range
        Dim subT_Formula As String
        lastRow = .Range("G9").End(xlDown).Row
        
        'total price formula
        For r = 9 To lastRow
            .Cells(r, 9).Formula = "=ROUND(F" & r & "*G" & r & "*(1-H" & r & "),2)"
        Next r
        
        'Total fruit
        .Cells(lastRow, 9).Formula = "=SUM(I2:I" & lastRow - 1 & ")/2"
        .Cells(lastRow, 7).Formula = "=SUM(G2:G" & lastRow - 1 & ")/2"
    
        'intermediate sub-totals
        .Cells(9, 9).Select
        For r = 9 To lastRow - 1
            Set r1 = ActiveCell
                Do Until ActiveCell.Font.Bold = True
                    ActiveCell.Offset(1, 0).Select
                Loop
            Set r2 = ActiveCell.Offset(-1, 0)
            subT_Formula = "=sum(" & r1.Address(0, 0) & ":" & r2.Address(0, 0) & ")"
            ActiveCell.Formula = subT_Formula
            ActiveCell.Copy
            ActiveCell.Offset(0, -2).Select
            Selection.PasteSpecial Paste:=xlPasteFormulas
            ActiveCell.Offset(1, 2).Select
            r = ActiveCell.Row
        Next r
        
        'grand total
        .Cells(lastRow + 2, 9).Formula = "=I" & lastRow
        .Cells(lastRow + 2, 7).Formula = "=G" & lastRow
    End With
End Sub

[titit34]

Thank you so much once again Kevin! It's almost perfect. There is only a problem with the percentage column:
The format seems to be wrong as the total cell shows #VALUE!
I attached the worksheet to this reply.
Warmest regards.

[Kevin#]

That is very peculiar.
- I opened your file and (like you said) the end column shows #VALUE.
- Because it is a new file to my system I must click on "Enable Editing" to modify.
- When I did that all those values became proper numbers

I have done nothing here to make it work other than apply my own settings to the file.
- My Excel is treating the percentage correctly , yours thinks it is text (perhaps!)
- I suspect a minor regional setting difference is causing this.
- Your Excel is behaving differently to mine. Are you also using Excel2016?

Try out this modified code . I cannot replicate what happens in your Excel.
Let me know if it does not work and I will provide a few suggestions as to what you could try.

Sub InsertTotals2()
    With ActiveSheet
        Dim lastRow As Long
        Dim subT As Double
        Dim r1 As Range, r2 As Range
        Dim subT_Formula As String
        Dim disc As Variant
        lastRow = .Range("G9").End(xlDown).Row
        
        For r = 9 To lastRow
            'total price formula
            .Cells(r, 9).Formula = "=ROUND(F" & r & "*G" & r & "*(1-H" & r & "),2)"
            're-format discount column
            .Cells(r, 8) = .Cells(r, 8).Value
            disc = --.Cells(r, 8).Value
            If disc = 0 Then disc = ""
            .Cells(r, 8) = disc
        Next r
        
        'Total fruit
        .Cells(lastRow, 9).Formula = "=SUM(I2:I" & lastRow - 1 & ")/2"
        .Cells(lastRow, 7).Formula = "=SUM(G2:G" & lastRow - 1 & ")/2"
    
        'intermediate sub-totals
        .Cells(9, 9).Select
        For r = 9 To lastRow - 1
            Set r1 = ActiveCell
                Do Until ActiveCell.Font.Bold = True
                    ActiveCell.Offset(1, 0).Select
                Loop
            Set r2 = ActiveCell.Offset(-1, 0)
            subT_Formula = "=sum(" & r1.Address(0, 0) & ":" & r2.Address(0, 0) & ")"
            ActiveCell.Formula = subT_Formula
            ActiveCell.Copy
            ActiveCell.Offset(0, -2).Select
            Selection.PasteSpecial Paste:=xlPasteFormulas
            ActiveCell.Offset(1, 2).Select
            r = ActiveCell.Row
        Next r
        
        'grand total
        .Cells(lastRow + 2, 9).Formula = "=I" & lastRow
        .Cells(lastRow + 2, 7).Formula = "=G" & lastRow
    End With
End Sub

[titit34]

Sorry Kevin, I wrote a feedback for your last advise but I found out I never sent it.. It was just fine with the new code no worries.
By default, it is 0% discount. When I manually change some values, it turns to be a percentage format I can deal with.
Thank you again for your help ! I really appreciate it.
Warmest regards.
Thierry