View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Ron Rosenfeld[_2_] Ron Rosenfeld[_2_] is offline
external usenet poster
 
Posts: 1,045
Default Macro to add up values in COMMENTs

On Thu, 01 Jul 2010 23:11:20 -0400, Ron Rosenfeld
wrote:

On Wed, 30 Jun 2010 12:14:30 -0700 (PDT), pcor
wrote:

Hi
I did receive an very nice macro to carryout a search of ALL comments
on a worksheet. What I really wanted was to have a macro that would
provide a total for an active cell.
IE
If I put my cursor on a12, and A12 contains a comment such as:
apples=12
oranges=23
The macro would place the value of 35(12+23) in that cell.
Thanks in advance


It's helpful if you keep your topic in a single thread.

But all you need to do is modify the macro so it only looks at the
active cell.

For example, you could change this line:

Set rg = Cells.SpecialCells(xlCellTypeComments)

to

Set rg = ActiveCell

and you're done.

Or you could do a little more rewriting to make it more compact.

You did not indicate what you want to have done if you run the macro
but ActiveCell has no comment. In this modification, I give you the
opportunity to make a choice.

As before, this adds up only positive integer values. If you may have
decimal or negative values, it would require merely a change in
re.pattern.

================================
Option Explicit
Sub AddUpComments()
'adds up integers in comments
'in active cell
Dim sComment As String
Dim sTotal As Long
Dim re As Object, mc As Object, m As Object

Set re = CreateObject("vbscript.regexp")
re.Pattern = "\b\d+\b"
re.Global = True

With ActiveCell
sTotal = 0
On Error GoTo NoComment
sComment = .Comment.Text
On Error GoTo 0
If re.test(sComment) = True Then
Set mc = re.Execute(sComment)
For Each m In mc
sTotal = sTotal + m
Next m
.Value = sTotal
Else
.ClearContents
End If
End With
Exit Sub
========================



Oops, I left out the last few lines of the sub.

Let's try again:

============================
Option Explicit
Sub AddUpComments()
'adds up integers in comments
'in active cell
Dim sComment As String
Dim sTotal As Long
Dim re As Object, mc As Object, m As Object

Set re = CreateObject("vbscript.regexp")
re.Pattern = "\b\d+\b"
re.Global = True

With ActiveCell
sTotal = 0
On Error GoTo NoComment
sComment = .Comment.Text
On Error GoTo 0
If re.test(sComment) = True Then
Set mc = re.Execute(sComment)
For Each m In mc
sTotal = sTotal + m
Next m
.Value = sTotal
Else
.ClearContents
End If
End With
Exit Sub

NoComment: If MsgBox("No Comment in Cell!" & vbLf & _
"Clear Cell Contents?", vbYesNo) = vbYes Then
ActiveCell.ClearContents
End If
End Sub
===================================