VBA to automatically enter totals a the bottom of individual columns

[KlayontKress]

To all,


I am looking for a VBA code to find the last row of data in Column A (the column has non-continuous data), go down 2 rows (leave 1 blank row between the last row of data and the cell selected) and enter total. Then from column E to how ever many columns have data, enter the sum of each column from E7 to the last row of data. The data always starts at E7 but may go over 3 column or it may go over 150 columns.

Below is a sample of what my sheet looks like


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[TD]K
[/TD]
[TD]L
[/TD]
[TD]M
[/TD]
[TD]N
[/TD]
[TD]O
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]BLAH
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]BLAH
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]BLAH
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]BLAH
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]DESCRIPTION
[/TD]
[TD]QTY
[/TD]
[TD]MODIFICATIONS
[/TD]
[TD]OPTIONS
[/TD]
[TD]COLOR 1
[/TD]
[TD]COLOR 2
[/TD]
[TD]COLOR 3
[/TD]
[TD]COLOR 4
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]ASDF
[/TD]
[TD]#
[/TD]
[TD]ASDF,ASDF
[/TD]
[TD][/TD]
[TD]$$
[/TD]
[TD]$
[/TD]
[TD]$$$
[/TD]
[TD]$
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]ASDF
[/TD]
[TD]#
[/TD]
[TD]FDSA
[/TD]
[TD][/TD]
[TD]$
[/TD]
[TD]$$
[/TD]
[TD]$
[/TD]
[TD]$$
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]ASDF
[/TD]
[TD]#
[/TD]
[TD]FDSA
[/TD]
[TD][/TD]
[TD]$$
[/TD]
[TD]$$
[/TD]
[TD]$
[/TD]
[TD]$$$
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]ASDF
[/TD]
[TD]#
[/TD]
[TD][/TD]
[TD][/TD]
[TD]$$
[/TD]
[TD]$
[/TD]
[TD]$$$
[/TD]
[TD]$
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD]ASDF
[/TD]
[TD]#
[/TD]
[TD]ASDF
[/TD]
[TD][/TD]
[TD]$
[/TD]
[TD]$$$
[/TD]
[TD]$$
[/TD]
[TD]$$
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14
[/TD]
[TD](WANT TO INSERT TOTAL HERE)
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD](WANT TO TOTAL COLUMN FROM E7:E12)
[/TD]
[TD](WANT TO TOTAL COLUMN FROM F7:F12)
[/TD]
[TD](WANT TO TOTAL COLUMN FROM G7:G12)
[/TD]
[TD](WANT TO TOTAL COLUMN FROM H7:H12)
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Fluff]

Hi, how about

Sub AddTotals()

    Dim TotRw As Long
    Dim UsdCols As Long
    
    TotRw = Range("A" & Rows.Count).End(xlUp).Offset(2).Row
    UsdCols = Cells(6, Columns.Count).End(xlToLeft).Column
    
    Range("A" & TotRw).Value = "Total"
    Range("E" & TotRw).Resize(, UsdCols - 4).FormulaR1C1 = "=sum(r7c:r[-2]c)"
    

End Sub

 

[Stiuart_W]

This should do the trick:-

Sub DoStuff()
    Dim LastRow, LastColumn As Integer
    Dim ColLetter As String
    
    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    LastColumn = ActiveSheet.Cells(7, Columns.Count).End(xlToLeft).Column
    
    vArr = Split(Cells(1, LastColumn).Address(True, False), "$")
    ColLetter = vArr(0)
    Range("E" & LastRow + 2 & ":" & ColLetter & LastRow + 2).Formula = "=SUM(E7:" & ColLetter & LastRow & ")"
End Sub

 

[Scott T]

This code will add total the totals

Sub addtotals()
Dim lr As Long
Dim lc As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(6, Columns.Count).End(xlToLeft).Column
rdif = lr + 2 - 7
Cells(lr + 2, 1) = "TOTAL"
For x = 5 To lc
    Cells(lr + 2, x).FormulaR1C1 = "=SUM(R[-" & rdif & "]C:R[-2]C)"
Next x
End Sub

 

[wideboydixon]

Public Sub KlaytontKress()

Dim lastCol As Long
Dim thisCol As Long
Dim lastRow As Long
Dim thisRow As Long

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(6, Columns.Count).End(xlToLeft).Column

For thisCol = 5 To lastCol
    With Cells(lastRow + 2, thisCol)
        .FormulaR1C1 = "=SUM(R[" & 5 - lastRow & "]C:R[-2]C)"
        ' .Value = .Value
    End With
Next thisCol

End Sub

You can uncomment the line if you want to keep the values and not the formula.

WBD

 

[KlayontKress]

Thank you all for the responses. All of them seem to work as intended. The one from fluff is a bit cleaner and I will probably use that one.

Thanks again.

 

[Fluff]

Glad we could help & thanks for the feedback