Link to home
Start Free TrialLog in
Avatar of av281
av281

asked on

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
Avatar of James Elliott
James Elliott
Flag of United Kingdom of Great Britain and Northern Ireland image

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
Avatar of Chris Bottomley
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

Avatar of av281
av281

ASKER

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

Avatar of av281

ASKER

sorry, I don't get it
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

Avatar of av281

ASKER

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
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
Avatar of av281

ASKER

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!
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
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
Avatar of av281

ASKER

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
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
Avatar of av281

ASKER

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
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
Testing is causing me a problem as the currentrow is undefined when opening the books ... how is it defined?

Chris
Avatar of av281

ASKER

I attach the file,
it's easier that way!

Calibration-bed-status-sheet-hom.xls
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
Avatar of av281

ASKER

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
:)
Moved the reset earlier in teh script ... fingers crossed!

Chris
Calibration-bed-status-sheet-hom.xls
Avatar of av281

ASKER

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
ASKER CERTIFIED SOLUTION
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of av281

ASKER

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!
Avatar of av281

ASKER

Good work mate, you really helped me there!
Cheers