macro to extract comment data to specified cell in another workbook

I need help with my current macro so that: it will look in several cells (i,j) if comment(s) are found, write it in a particular cell of a diferent workbook so that you end up with all comments written in that cell. If no comment are found then search until the end of the range (or until all comments are found). My current problem is that it is repeatedly writing the comments it finds and I end up with the same number of comments in one cell as number of cells in myrange but its always the same comment.
Thanks
av281Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

James ElliottManaging DirectorCommented:
Can you post the code you're using?

A starting point might be:

Option Explicit

Sub ShowComments()
    Dim rng As Range
   
For Each rng In UsedRange
    rng = rng.Comment.Text
    rng.Comment.Delete
Next rng

End Sub
0
Chris BottomleySoftware Quality Lead EngineerCommented:
You could try the following concept:

I have tried to adapt to stripp the user details out, see how it works modifying references to K1 as the cell to write to so that it reflects your choice.

Chris
Sub collatecomments()
Dim cmtText As String
Dim cmt As Comment
 
    ActiveSheet.Range("K1") = ""
    For Each cmt In ActiveSheet.Comments
        If Left(cmt.Text, Len(Application.UserName)) = Application.UserName Then
            cmtText = Mid(cmt.Text, Len(Application.UserName) + 4)
        Else
            cmtText = cmt.Text
        End If
        If InStr(ActiveSheet.Range("K1"), cmtText & vbLf) = 0 Then ActiveSheet.Range("K1") = ActiveSheet.Range("K1") & cmtText & vbLf
    Next
    ActiveSheet.Range("K1") = Left(ActiveSheet.Range("K1"), Len(ActiveSheet.Range("K1")) - 1)
End Sub

Open in new window

0
av281Author Commented:
Here is the macro I wrote for it, what happens is that, p.e. if it finds a comment "a" it wiil write "a"  in the desired cell as it should, however it will continue to write that same comment until it finds another one, so I get  something like (aaaaa, bbbbb) i.e. it found comment "a" and coment "b" in the range of 10 cells it looked at.
Thanks.

comment_text = 1
        For j = 14 To 26
             For i = currentrow To currentrow + 2
                            On Error Resume Next
                              newcomment = Cells(i, j).Comment.Text
                               If newcomment <> "" Then
                                     If comment_text = 1 Then
                                     comment_text = newcomment
                                      Else
                                      comment_text = comment_text & Chr(10) & newcomment
                                     End If
                             End If
                   Next i
            Next j
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

Chris BottomleySoftware Quality Lead EngineerCommented:
Your implication is that you do not have the commentator name therefore you could use:

Chris
Sub collatecomments()
Dim cmtText As String
Dim cmt As Comment
 
    ActiveSheet.Range("K1") = ""
    For Each cmt In ActiveSheet.Comments
        If InStr(ActiveSheet.Range("K1"), cmt.Text & vbLf) = 0 Then ActiveSheet.Range("K1") = ActiveSheet.Range("K1") & cmt.Text & vbLf
    Next
    ActiveSheet.Range("K1") = Left(ActiveSheet.Range("K1"), Len(ActiveSheet.Range("K1")) - 1)
End Sub

Open in new window

0
av281Author Commented:
sorry, I don't get it
0
Chris BottomleySoftware Quality Lead EngineerCommented:
DOn't worry .. just realised you wanted to work with a fixed range the following should work and the range is as used in your post ... if I got it right

Chris
Sub collateComments2()
Dim i As Integer
Dim j As Integer
Dim cmtText As String
Dim cellText As String
    
    For j = 14 To 26
        For i = Application.Selection.row To Application.Selection.row + 2
            With ActiveSheet.Cells(i, j)
                If Not .Comment Is Nothing Then
                    If Left(.Comment.Text, Len(Application.UserName)) = Application.UserName Then
                        cmtText = Mid(.Comment.Text, Len(Application.UserName) + 3)
                    Else
                        cmtText = .Comment.Text
                    End If
                    If InStr(cellText, cmtText & vbLf) = 0 Then cellText = cellText & cmtText & vbLf
                End If
            End With
        Next i
    Next j
    If cellText <> "" Then
        ActiveSheet.Range("K1") = Left(cellText, Len(cellText) - 1)
    Else
        ActiveSheet.Range("K1") = ""
    End If
End Sub

Open in new window

0
av281Author Commented:
Thanks for that!
Any ideas why I'm getting an error: "end with without with"
with that script, will the commentator name appear as well? If yes, how do I make it not to appear?
Cheers
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Commentator name should be suppressed ... I did test for it, and similarly without it.

As for end with ... I don't think I did something stupid as it doesn't appear for me.  Have you some more code in the module? .. if so post the code and we can check it over.

Chris
0
av281Author Commented:
Chris,
Commentator name supressed-OK!
the error I was getting earlier was because there is a "end if" missing before "end with", so that's sorted.
I am very happy with your code as it is working. I just changed one bit:
I replaced
 For i = Application.Selection.row To Application.Selection.row + 2
with:
for i=currentrow to currentrow+2

I now have another problem though. it is doing what it should, so it writes the comments it finds and puts them in the desired cell (without the repeating issue). Its fine up to that point.
Now, I have to do this for various different workbooks, so I need to look in diferent workbooks and for each one of them put the comments in the one diferent cell in the "results workbook".,
not sure if I explained right, but effectively what it is doing is that when I run the macro again for a different workbook it will use the comments it found previously and add the new ones it finds from the new workbook. How do you make it to reset it  so that it will only write the comments corresponding to the workbook it is looking at.
Since you are being of such good help, I have another question, when it writes the comments into the cell, how can I make the cell to adjust the size according to the amount of text its in it so that I dont get hidden text in the cell?

Thanks for your help!
0
Chris BottomleySoftware Quality Lead EngineerCommented:
The way it is designed currently is to work with the active sheet i.e. the active workbook.

YOu need something like:

dim wb as workbook
dim ws as worksheet

for each wb in application.workbooks
    for each ws in wb.worksheets
    next
next

Depends on if you want to do this on every open workbook and every worksheet in each of the open workbooks and you may need to define the results workbook seperately so that it is not processed.

Can you detail the processing you want?

Chris
0
Chris BottomleySoftware Quality Lead EngineerCommented:
I have an outline change that is working but I need to know for instance assuming each open workbook and each worksheet are to be processed ... is the results cell unique for each book/sheet or common for each sheet in a book or common for everything?

Chris
0
av281Author Commented:
What I need is:
opens workbook 1, worksheet "daily", read the comments close workbook 1
write comments in cell A1 in worksheet "status" of workbook_data. Then again:
open workbook 2, worksheet "daily", read comments on that worksheet then close it,
write those comments in cell A2 in worksheet "status" of workbook_data
and so on until there are no more workbooks.
thanks
0
Chris BottomleySoftware Quality Lead EngineerCommented:
So the macro will reside and be run from workbook_data and all workbooks in the folder containing _data are processed, (excl _data of course)?

Additionally populating a1 ... an, will not give info on the relevant workbook ... is that ok or do you want to write the workbook/sheet name info to for instance column a and b respectively with the string to column C?

Chris
0
av281Author Commented:
Yes, macro resides and run from workbook_data. All workbooks in folder "anyname" are processed, but workbook_data lives in a diferent folder.

No need to write workbook/sheet name info.

If you can please have a look as well as to resize/expand  the cell according to the amount of comment data are writen on it so that they can be all viewed. that's in workbook_data, worksheet_status.
.
Many thanks
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Needs the path to anyname defining ... i'll set it as a constant for ease.  If it is an offshoot of the _data book then as long as the relationship is maintained you may prefer to identify the branch relationship so that if higher level directories change the macro ought to still work.

Chris
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Testing is causing me a problem as the currentrow is undefined when opening the books ... how is it defined?

Chris
0
av281Author Commented:
I attach the file,
it's easier that way!

Calibration-bed-status-sheet-hom.xls
0
Chris BottomleySoftware Quality Lead EngineerCommented:
There is a fair bit to your macro ... I think I am following it so with two teeny changes it will hopefully work.  If you would be so kind as to try it.

Chris
Calibration-bed-status-sheet-hom.xls
0
av281Author Commented:
Yes, It's a long macro this one.
It is working. I tried it and w.r.t. the autofit column it's OK.
The only problem is the same as before, where it is adding the comments from the previous workbook, instead of only the comments from the relevant one...
Thanks, you are the one who is being so kind
:)
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Moved the reset earlier in teh script ... fingers crossed!

Chris
Calibration-bed-status-sheet-hom.xls
0
av281Author Commented:
Still the same I'm afraid.
I got to go now, will try a few thing and hopefully sort it out but anyways the main bit you've already sorted it.
Let me know if you got some more ideas, will let you know if I find out too.
Thanks and speak ot you tomorow
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Sorry but I am at a loss:

I believe you reset the woerksheets to the next one with this line:

              Workbooks.Open "C:\Documents and Settings\flucio2\My Documents\cal bed status\Cell " & testcell & " Availability.xls", UpdateLinks:=xlUpdateLinksAlways
Sheets("daily").Select

The last change resets the cmttext variable just after this so it should be blank before looping through the range on each worksheet.

I guess at the point of eriting the text it can be reset so my last try is as attached.

Chris
Calibration-bed-status-sheet-hom.xls
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
av281Author Commented:
Hi Chris,
Thank you so much for your help.
I tried it and you are right saying that the reset should be at the point of editing the text.
It work just fine when I changed cmtTex = "" to cellText = ""
Briliant work!
Many thanks!
0
av281Author Commented:
Good work mate, you really helped me there!
Cheers
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.