Try this:

Option Explicit
Sub AnalysisOfLeaves2A()
'Calculates amount of leavers from text in comments

Dim tot As Long
Dim num As Long
Dim cmt As Comment
Dim sStr As String
Dim iloc As Long
Dim myKeyWords As Variant
Dim iCtr As Long
Dim DestCell As Range

myKeyWords = Array("transfer out", "transfers out", "v. term")

tot = 0
For Each cmt In ActiveSheet.Comments
If Intersect(cmt.Parent, Selection.Columns(1)) Is Nothing Then
'do nothing
Else
For iCtr = LBound(myKeyWords) To UBound(myKeyWords)
sStr = cmt.Text
Do
iloc = InStr(1, sStr, myKeyWords(iCtr), vbTextCompare)
If iloc 0 Then
If IsNumeric(Mid(sStr, iloc - 2, 2)) Then
num = CLng(Mid(sStr, iloc - 2, 2))
tot = num + tot
Else
MsgBox "error on: " & cmt.Parent.Address(0, 0)
End If
Else
Exit Do
End If
sStr = Mid(sStr, iloc + Len(myKeyWords(iCtr)))
Loop
Next iCtr
End If
Next cmt

With Selection.Columns(1)
Set DestCell = .Cells(.Cells.Count).Offset(32)
End With

DestCell.Value = tot

End Sub



malik641 wrote:

Dave,
THANKS! That works great!!! Perfect!!

I just have ONE MORE question...

Instead of having the range be specific (i.e. C4:C44). How do I make it
so that you select a certain amount of cells, and then place the answer
a certain amount of cells lower than my last selected cell in the
column (selected cells will only be one column wide but many rows
down). Here's an example:

Cells C4:C44 are selected

Answer will be 32 spaces below C44 (C76).

This will be the LAST thing I promise (well, I hope anyway)

--
malik641
------------------------------------------------------------------------
malik641's Profile: http://www.excelforum.com/member.php...o&userid=24190
View this thread: http://www.excelforum.com/showthread...hreadid=386198

--

Dave Peterson