ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   auto sum macro if data is present above the cell (https://www.excelbanter.com/excel-programming/314441-auto-sum-macro-if-data-present-above-cell.html)

onesaint[_8_]

auto sum macro if data is present above the cell
 

works like a charm! is there a way to make the totals bold? lik
Selection.Font.Bold = True
or something? thank you again for the help

--
onesain
-----------------------------------------------------------------------
onesaint's Profile: http://www.excelforum.com/member.php...nfo&userid=937
View this thread: http://www.excelforum.com/showthread.php?threadid=27095


Myrna Larson

auto sum macro if data is present above the cell
 
See added line marked with <<<<<<

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))
.Font.Bold = True '<<<<<<
End With

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

Loop While WordTotal.Row < FirstTotalRow

End Sub

On Fri, 22 Oct 2004 15:02:36 -0500, onesaint
wrote:


works like a charm! is there a way to make the totals bold? like
Selection.Font.Bold = True
or something? thank you again for the help.



y8g5k3m

auto sum macro if data is present above the cell
 

What if you are summing up a number of columns- Offset with range? Than
you


Myrna Larson Wrote:
See added line marked with <<<<<<

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))
.Font.Bold = True '<<<<<<
End With

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

Loop While WordTotal.Row < FirstTotalRow

End Sub

On Fri, 22 Oct 2004 15:02:36 -0500, onesaint
wrote:


works like a charm! is there a way to make the totals bold? like
Selection.Font.Bold = True
or something? thank you again for the help


--
y8g5k3
-----------------------------------------------------------------------
y8g5k3m's Profile: http://www.excelforum.com/member.php...fo&userid=2568
View this thread: http://www.excelforum.com/showthread.php?threadid=27095



All times are GMT +1. The time now is 07:00 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com