auto sum macro if data is present above the cell

O

onesaint

total needs to be underneath ive come up with this but it isnt looping
to the next area of data this is it;


Sub A_This_one_works()
Dim rwIndex As Integer
Dim colIndex As Integer
Dim i As Integer

colIndex = 14
For rwIndex = 1 To 5
If Cells(rwIndex, colIndex).Value <> 0 Then
i = i + 1
End If
Next rwIndex

If Range("L14").End(xlUp).Offset(1, 0).Select = "" Then
Selection.FormulaR1C1 = "=SUM(R[" & -i & "]C:R[-1]C)"
End If

Selection.FormulaR1C1 = "=SUM(R[" & -i & "]C:R[-1]C)"

End Sub

im not real sure how it works my self(not good programming practices)
but in paying around i got it to go. if i change the colindex and the
Range its goes to the last set of numbers and sums those. and lastly
the blank cell is allready under the last number in the set of data.
thanks for all your help i realy do appreciate it.
 
M

Myrna Larson

See how this works. The column number may not be right. You said column 14,
then column L. L is 12.

Option Explicit

Sub AddTotalFormulas()
Dim FirstTotalRow As Long
Dim FirstValue As Range
Dim FormulaTemplate As String
Dim SearchRange As Range
Dim RowOffset As Long
Dim SumFormula As Range
Dim WordTotal As Range

Const FormulaColumn = 14

FormulaTemplate = "=SUM(R[#]C:R[-1]C)"

With ActiveSheet
Set SearchRange = Intersect(.UsedRange, .Columns(FormulaColumn - 1))
End With

With SearchRange
Set WordTotal = .Find(What:="total", _
LookIn:=xlValues, LookAt:=xlPart, _
After:=.Cells(.Cells.Count), _
SearchDirection:=xlNext, _
MatchCase:=False)

If WordTotal Is Nothing Then
MsgBox "Can't find the word 'total' in column " _
& Chr$(SearchRange.Column + 64) & "!", vbOKOnly
Exit Sub
Else
FirstTotalRow = WordTotal.Row
End If
End With


Do
Set SumFormula = WordTotal.Offset(0, 1)
With SumFormula
Set FirstValue = .Offset(-1, 0) 'correct for 0 or 1 values
If FirstValue.Offset(-1, 0) <> "" Then
Set FirstValue = FirstValue.End(xlUp)
End If

RowOffset = FirstValue.Row - .Row
.FormulaR1C1 = Replace(FormulaTemplate, "#", Format$(RowOffset))

End With

Set WordTotal = SearchRange.FindNext(After:=WordTotal)

Loop While WordTotal.Row <> FirstTotalRow

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top