Place sum beneath each column in range in Excel - excel

Question

I have code that will clear everything below the "----" on a spreadsheet full of data. The "----"comes from an export into excel and I don't want data located under it, so I clear it.
After the code clears everything underneath the "----", I want to sum each column in a range and then place each column total underneath its column of data. The column range is F thru T. I'd like to be able to change this range in the code for other projects.
The row may not be the same each time, so the code must sum the columns after the last row of data.
Can anyone help with this, thanks!
Sub Remove_everything_under()
Dim mtch As Long
mtch = 0
On Error Resume Next
mtch = Application.WorksheetFunction.Match("----", ActiveSheet.Range("A:A"), 0) + 0
On Error GoTo 0
If mtch > 0 Then
ActiveSheet.Range("A" & mtch, ActiveSheet.cells(Rows.Count, Columns.Count)).ClearContents
End If
End Sub

Answer 1

Sum-up Variable Sized Column Ranges
Description
Adjust the values in the constants section.
You can easily rewrite the procedure to use some of the constants as arguments for multi-purpose use.
The following will sum up the columns defined by cAddress and put the results (sums) to the cells below each non-empty column range. Executing it again will double the previous result each next time.
Some Challenges
Sum will fail if an error value so the cells of the column range have to be looped through. Solved.
Sum will sum up date values. Not solved, but not an issue when looping.
The loop will sum up TRUE as -1. Solved, but not an issue when Sum is used.
Option Explicit
Sub sumupVariableSizedColumnRanges()
Const cAddress As String = "F:T" ' Columns Address
Const FirstRow As Long = 2 ' First Row
Const hasDates_Slow As Boolean = True ' If 'True', then loop always.
Dim frOffset As Long: frOffset = FirstRow - 1 ' First Row Offset
Dim rg As Range ' Initial Range: from FirstRow to last worksheet row.
With ActiveSheet.Columns(cAddress)
Set rg = .Resize(.Rows.Count - frOffset).Offset(frOffset)
'Debug.Print "Initial Range address = " & rg.Address(0, 0)
End With
Dim crg As Range ' Column Range
Dim rrg As Range ' Result Range
Dim lCell As Range ' Last Cell (Range)
Dim cError As Long ' Current Error Number
Dim Result As Double ' Result
' If error, then loop.
Dim Data As Variant ' Data Array
Dim cValue As Variant ' Current Value
Dim r As Long ' Data Array Rows Counter
' Starting idea if same last row for all columns:
' Set lCell = rg.Find("*", , xlFormulas, , xlByRows, xlPrevious)
' If lCell Is Nothing Then Exit Sub
' Set rg = rg.Resize(lCell.Row - frOffset)
' Debug.Print "Processing Range address = " & rg.Address(0, 0)
For Each crg In rg.Columns
Set lCell = crg.Find("*", , xlFormulas, , , xlPrevious)
If Not lCell Is Nothing Then
Set rrg = crg.Resize(lCell.Row - frOffset)
'Debug.Print "Current Range address = " & rrg.Address(0, 0)
If hasDates_Slow Then
cError = -1 ' Dates are not summed up.
Else
On Error Resume Next ' Sum 'fails' if error values.
Result = Application.Sum(rrg) ' Dates are also summed up.
cError = Err.Number
On Error GoTo 0
End If
If cError <> 0 Then
'Debug.Print "Current Error Number = " & cError
cError = 0
Result = 0
If rrg.Rows.Count = 1 Then
ReDim Data(1 To 1, 1 To 1): Data = rrg.Value
Else
Data = rrg.Value
End If
For r = 1 To UBound(Data, 1)
cValue = Data(r, 1)
If IsNumeric(cValue) Then
If VarType(cValue) <> vbBoolean Then ' exclude TRUE = -1
Result = Result + cValue
End If
End If
Next r
Erase Data
End If
lCell.Offset(1).Value = Result
Set lCell = Nothing
End If
Next crg
End Sub