Personally, I think it's time to rethink your design--maybe way past time!

Put that data into separate columns in their own cells. It'll make life much
easier.



malik641 wrote:

That's weird, it says the same time on mine....hmm

Oh well. I'll just post it again. Here's what I wrote:

Remember when I said "This is last thing..."? well I have something
that I would like to ADD to this macro

This one is a little more challenging though

I had to adjust the macro a little bit for what I fully needed. Here's
what I ended up with.

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

Dim totTerm As Long-------------'Total number of terminations
Dim totNew As Long--------------'Total number of New Hires
Dim numN As Long----------------'Used for total number of New Hires
Dim cmt As Comment-------------'Variable for comments
Dim sStrT As String----------------'Used for text in comments for
Terminations
Dim sStrN As String----------------'Used for text in comments for New
Hires
Dim ilocT As Long-------------------'Number before keyword text in
comments for Terminations
Dim ilocN As Long-------------------'Number before keyword text in
comments for New Hires
Dim myKeyWordsT As Variant-----'Used to look up terminations
Dim myKeyWordsN As Variant-----'Used to look up new hires
Dim iCtrT As Long-------------------'Used to equal keywords for
Terminations
Dim iCtrN As Long-------------------'Used to equal keywords for New
Hires
Dim rng As Range-------------------'Selected cells

Set rng = Selection

'Sets key words for text lookup in comments
myKeyWordsT = Array("i. term", "v. term")
myKeyWordsN = Array("new hire")
totTerm = 0
totNew = 0
For Each cmt In ActiveSheet.Comments

'If statement for Terminations

If Intersect(cmt.Parent, rng) Is Nothing Then
'do nothing
Else
For iCtrT = LBound(myKeyWordsT) To UBound(myKeyWordsT)
sStrT = cmt.Text
Do
ilocT = InStr(1, sStrT, myKeyWordsT(iCtrT), vbTextCompare)
If ilocT 0 Then
If IsNumeric(Mid(sStrT, ilocT - 2, 2)) Then
numT = CLng(Mid(sStrT, ilocT - 2, 2))
totTerm = numT + totTerm
Else
MsgBox "Error on: " & cmt.Parent.Address(0, 0)
End If
Else
Exit Do
End If
sStrT = Mid(sStrT, ilocT + Len(myKeyWordsT(iCtrT)))
Loop
Next iCtrT
End If

Next cmt

For Each cmt In ActiveSheet.Comments

'If statement for New Hires

If Intersect(cmt.Parent, rng) Is Nothing Then
'do nothing
Else
For iCtrN = LBound(myKeyWordsN) To UBound(myKeyWordsN)
sStrN = cmt.Text
Do
ilocN = InStr(1, sStrN, myKeyWordsN(iCtrN), vbTextCompare)
If ilocN 0 Then
If IsNumeric(Mid(sStrN, ilocN - 2, 2)) Then
numN = CLng(Mid(sStrN, ilocN - 2, 2))
totNew = numN + totNew
Else
MsgBox "Error on: " & cmt.Parent.Address(0, 0)
End If
Else
Exit Do
End If
sStrN = Mid(sStrN, ilocN + Len(myKeyWordsN(iCtrN)))
Loop
Next iCtrN
End If

Next cmt

'Places New Hires in new hires cell
ActiveCell.Offset(43, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = totNew

'Places Terminations in termination cell
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = totTerm

End Sub

This works perfectly for what I originally needed to do. Now I need to
add a feature to this. And like I said this one is a BIGGER challenge
(If it isn't a big challenge, then sorry for the hype...I'm still a
novice :) ).

The reason I have this macro to begin with is to know how many hired
people there were and how many terminations there were (I forgot that
transfers didn't count, and I eliminated it as you can see in the
code). And with each cell that was selected holds a different
department of my company. Each having their own department number.

The numbers are placed adjacent to the selected cells (more
specifically B7:B34, B37:B42, and B46:B47...the reason for the gaps is
because of other "Total" values in the table) And as you know the
selected cells are the ones with comments that have the keyword values
and such.

Remember, this is an *ADDITION* to what I have...Everything else works
GREAT!

I need to know which department had ONLY the "V. Term" and "I. Term"
keywords. I also need to know to what amount (i.e. "5 V. Terms", like
in the code I have now) and THEN I need to place that specific number
in that one comment in a table BELOW the selected cells (still in the
same column, though) in coordinance with the same department number
based on cells B58:B78. Notice that there are less cells in the new
table than the one's adjacent to the selected cells. This is because
there are a few choice cells in B58:B78 (namely B71:B73, B75, and B78)
which instead of holding the numbers inside the cells as text, they
have comments with multiple department numbers (i.e. Comment:"152 + 134
+ 155").

Here is an example (this is the best I can come up with):
B7= 111------------------------------------C7=Comment:"1 V. Term"
B8= 112------------------------------------C8=Comment:"2 I. Terms"
B9= 113------------------------------------C9=Comment:"1 Transfer out"
B10=114-----------------------------------C10=Comment:"1 New Hire"
B11=115-----------------------------------C11=Comment:"1 Transfer In"
.......................................I should End up with the
following (IN Column C, Column B has set
values).............................
B69=111-----------------------------------C69=1
B70=Comment:"112 + 113 + 114"-----C70=2
B71=115-----------------------------------C71=0

Hope this isn't TOO difficult

--
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