PDA

View Full Version : Need to capture existing comments and place into cells, change then replace them



Teacher5th
02-15-2008, 09:32 PM
My classroom excel has 8 protected sheets with a lot of comments in them and it is a pain to keep them current. I need a way to go through all the sheets, capture the comments, place them on sheet called "Comments", with a reference to what sheet/cell they came from so I can change them. Then delete all the comments from the cells and either have the cells look at the new comments sheet to get the "Comments" or a routine to replace them in the same cells, hopefully, with a larger font and the colors I give to certain words. I'm not real good at VBA coding but I will try to learn from your code. thanks

Ago
02-16-2008, 12:57 AM
where are the comments?
makeing a makro that runs trough every cell in 8 sheets will take a very long time.

could you narrow it down a bit? ex: A-column, B-column, not higher than row 1000? and so on

gwkenny
02-16-2008, 03:31 AM
Actually, if you read everything into an array, and then at the end, write the array to a sheet, it's not that slow.

Someone actually requested this in the past week or two here (or on MrExcel). If I can find the thread, I'll post the link.

gwkenny
02-16-2008, 08:53 AM
Okay, the following will get all of your comments and dump them into the Comments worksheet starting in A4 (or is it A5).

It should actually be very quick!!!!

Now I can write back the comments, but I'm having trouble. Thus I haven't put that part of the code in here (but what I've got least gives you a report of all the comments and where they are).

ANYBODY OUT THERE KNOW how to write back comments with the Author in Bold and the comment text as regular text? Just like if it is done manually.

Through code, I cannot seem to do that. I can change the format of the comment shape, which changes ALL the text in the comment (to bold, italic, font size, whatever). But I cannot seem to change the format of part of the text in the comment field. Especially just the Author.

Anyone can give me a clue, I'd appreciate it, I'm stumped.



Option Explicit
Option Base 1

Sub ReadComments()
Dim wks_A As Worksheet
Dim rng_Comments As Range
Dim rng_A As Range
Dim sng_Count As Single
'Get total number of commented cells
sng_Count = 0
For Each wks_A In ActiveWorkbook.Worksheets
If wks_A.Name = "Comments" Then
'do nothing
Else
Set rng_A = wks_A.Cells.SpecialCells(xlCellTypeComments)
sng_Count = sng_Count + rng_A.Cells.Count
End If
Next
'Dimension string array to hold commented cells
ReDim str_Com(sng_Count, 4)

'Record comment data
sng_Count = 0
For Each wks_A In ActiveWorkbook.Worksheets
If wks_A.Name = "Comments" Then
'do nothing
Else
For Each rng_A In wks_A.Cells.SpecialCells(xlCellTypeComments)
sng_Count = sng_Count + 1
str_Com(sng_Count, 1) = wks_A.Name
str_Com(sng_Count, 2) = rng_A.Address
str_Com(sng_Count, 3) = rng_A.Comment.Author
str_Com(sng_Count, 4) = rng_A.Comment.Text
Next
End If
Next
'Prep and Write Comment Data Collected

ActiveWorkbook.Worksheets("Comments").Range("A4").CurrentRegion.Offset(1, 0).ClearContents
ActiveWorkbook.Worksheets("Comments").Cells(4, 1).Resize(sng_Count, 4) = str_Com



End Sub

Teacher5th
02-16-2008, 10:11 AM
Thank you Thank you for helping my classroom. To answer the first gentleman, I could condense the search from a1 to IV1000. To gwkenny - thank you for taking an interest with your code -IT WORKS great! Now if we can find someone who can figure how to write it back to the same cells. Anyone!!

Teacher5th
02-16-2008, 02:58 PM
Tried it on two existing workbooks and got the error so I opened a new one with 3 sheets, named one sheet comments, opened vba, copied the code to the comments sheet and ran it but same error. It works perfectly on the XLS you wrote.
error 1004 application defined or object defined error
sng_Count = sng_Count + rng_A.Cells.Count
Any Ideas?

mikerickson
02-16-2008, 04:48 PM
This file has two routines recordComments and UpdateComments
RecordComments will read the comments from Sheet2 and put them in column A of Comments sheet.
UpdateComments will take the changes made to Comment sheet and apply them to the comments on Sheet2.
Changing the format (color, fontsize, etc) increases the run time dramaticaly. If you want to forgo that, comment out the indicated lines.
Speed can also be increased by deleting lines in CommentToCell and CellToComment that deal with features you don't want. (It does not account for more than one format per cell, that takes even longer.)

Sub recordComments()
Dim sourceSheet As Worksheet, oneCell As Range
Dim editCommentSheet As Worksheet
Dim i As Long
Set sourceSheet = ThisWorkbook.Sheets("Sheet2")
Set editCommentSheet = ThisWorkbook.Sheets("Comments")
Application.ScreenUpdating = False
For Each oneCell In sourceSheet.Cells.SpecialCells(xlCellTypeComments)
i = i + 1
editCommentSheet.Cells(i, 1).Value = oneCell.comment.Text
Call commToCell(oneCell, editCommentSheet.Cells(i, 1)): Rem removable
editCommentSheet.Cells(i, 2) = oneCell.Parent.Name & "!" & oneCell.Address
Next oneCell
Application.ScreenUpdating = True
End Sub

Sub UpdateComments()
Dim sourceSheet As Worksheet, oneCell As Range
Dim editCommentSheet As Worksheet
Dim i As Long
Application.ScreenUpdating = False
Set sourceSheet = ThisWorkbook.Sheets("Sheet2")
Set editCommentSheet = ThisWorkbook.Sheets("Comments")

With editCommentSheet
For Each oneCell In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Range(oneCell.Offset(0, 1).Value).comment.Text Text:=oneCell.Text
Call CellToComment(oneCell, Range(oneCell.Offset(0, 1).Value)): Rem removable
Next oneCell
End With
Application.ScreenUpdating = True
End Sub

Sub commToCell(commentCell As Range, writeToCell As Range)
With writeToCell
.Value = commentCell.comment.Text
With .Characters(1, Len(.Value)).Font
.Size = commentCell.comment.Shape.TextFrame.Characters(1, 1).Font.Size
.Name = commentCell.comment.Shape.TextFrame.Characters(1, 1).Font.Name
.Size = commentCell.comment.Shape.TextFrame.Characters(1, 1).Font.Size
.ColorIndex = commentCell.comment.Shape.TextFrame.Characters(1, 1).Font.ColorIndex
.Italic = commentCell.comment.Shape.TextFrame.Characters(1, 1).Font.Italic
.Bold = commentCell.comment.Shape.TextFrame.Characters(1, 1).Font.Bold
End With
End With
End Sub

Sub CellToComment(getFromCell As Range, commentCell As Range)
With commentCell
.comment.Text Text:=getFromCell.Value
With .comment.Shape.TextFrame.Characters(1, Len(getFromCell.Value)).Font
.Name = getFromCell.Characters(1, 1).Font.Name
.Size = getFromCell.Characters(1, 1).Font.Size
.ColorIndex = getFromCell.Characters(1, 1).Font.ColorIndex
.Italic = getFromCell.Characters(1, 1).Font.Italic
.Bold = getFromCell.Characters(1, 1).Font.Bold
End With
End With
End Sub

Teacher5th
02-16-2008, 09:17 PM
Thank you Mickrickson - It worked beautifully. Before I place it in my 12 sheet workbook, how can I have it go through all sheets? And I'm not sure how to change the (1, 1) for the:
Size
Name
Bold
Italic
ColorIndex

TO make it faster, can we start the counting up from row A1000:IV1000

THere are two sizes in commtocell - Is that right?
Thank you again - You guys really are helful and I appreciate it.

gwkenny
02-16-2008, 09:57 PM
error 1004 application defined or object defined error
sng_Count = sng_Count + rng_A.Cells.Count
Any Ideas?

Yup, I didn't take into account that you had a sheet with no comments. Thus when it tries to get rng_A.Cells.Count it errors out, there are no cells to count :)


MIKE: I did not post my write routine yet because I could not figure out a way (without using sendkeys) to separate AUTHOR from Comment Text so you can format them differently. Or just portions of the comment text.

The OP asked that she retains the colors she gives certain words. The way you've done it (and the only way I know of directly) is to use the Shape and that does the entire comment text.

Do you know of a way to retain or format only parts of the comment? Does not look like Microsoft gave us a way.

Additionally, your code would be significantly faster if you used arrays. Though I'm not sure how much speed you would achieve writing back comments from an array instead of a spreadsheet. Just might be geeky to test it! :D

mikerickson
02-16-2008, 10:13 PM
Here is a modification that will do all sheets.
Unless there are comments above row 1000, starting the counting from there will not speed things up.
Yes, there was an unnessesary .Size line.
Why would you want to change the (1,1) for the various properties? What would be it's purpose?


Sub recordAllSheetsComments()
Dim oneSheet As Worksheet
ThisWorkbook.Sheets("Comments").UsedRange.ClearContents
For Each oneSheet In ThisWorkbook.Sheets
If oneSheet.Name <> "Comments" Then
Call recordComments(oneSheet)
End If
Next oneSheet
End Sub

Sub recordComments(sourceSheet As Worksheet)
Dim oneCell As Range
Dim editCommentSheet As Worksheet
Dim i As Long
Set editCommentSheet = ThisWorkbook.Sheets("Comments")
i = editCommentSheet.Range("A65536").End(xlUp).Row
If editCommentSheet.Cells(i, 1) = vbNullString Then i = i - 1
Application.ScreenUpdating = False
For Each oneCell In sourceSheet.Cells.SpecialCells(xlCellTypeComments)
i = i + 1
editCommentSheet.Cells(i, 1).Value = oneCell.Comment.Text
Call commToCell(oneCell, editCommentSheet.Cells(i, 1)): Rem removable
editCommentSheet.Cells(i, 2) = oneCell.Parent.Name & "!" & oneCell.Address
Next oneCell
Application.ScreenUpdating = True
End Sub

Sub UpdateComments()
Dim oneCell As Range
Dim editCommentSheet As Worksheet
Dim i As Long
Application.ScreenUpdating = False

Set editCommentSheet = ThisWorkbook.Sheets("Comments")

With editCommentSheet
For Each oneCell In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Range(oneCell.Offset(0, 1).Value).Comment.Text Text:=oneCell.Text
Call CellToComment(oneCell, Range(oneCell.Offset(0, 1).Value)): Rem removable
Next oneCell
End With
Application.ScreenUpdating = True
End Sub

Sub commToCell(commentCell As Range, writeToCell As Range)
With writeToCell
.Value = commentCell.Comment.Text
With .Characters(1, Len(.Value)).Font
.Size = commentCell.Comment.Shape.TextFrame.Characters(1, 1).Font.Size
.Name = commentCell.Comment.Shape.TextFrame.Characters(1, 1).Font.Name
On Error Resume Next
.ColorIndex = commentCell.Comment.Shape.TextFrame.Characters(1, 1).Font.ColorIndex
On Error GoTo 0
.Italic = commentCell.Comment.Shape.TextFrame.Characters(1, 1).Font.Italic
.Bold = commentCell.Comment.Shape.TextFrame.Characters(1, 1).Font.Bold
End With
End With
End Sub

Sub CellToComment(getFromCell As Range, commentCell As Range)
With commentCell
.Comment.Text Text:=getFromCell.Value
With .Comment.Shape.TextFrame.Characters(1, Len(getFromCell.Value)).Font
.Name = getFromCell.Characters(1, 1).Font.Name
.Size = getFromCell.Characters(1, 1).Font.Size
.ColorIndex = getFromCell.Characters(1, 1).Font.ColorIndex
.Italic = getFromCell.Characters(1, 1).Font.Italic
.Bold = getFromCell.Characters(1, 1).Font.Bold
End With
End With
End Sub

mikerickson
02-16-2008, 10:31 PM
GWKenny,
Originaly I wrote it to loop through each character with
.Characters(loopIndex, 1).Font.(Property)
, but that was hideously slow. The arguments of Characters are similar to arguments for MID.
That's the technique I would use to support multiple formats in each comment.

Many kinds of information in one cell (cell contents, cell comment, multiple sub-strings in the comments, differentiated by color) just leads to headaches.
If the comments need to be frequently modified, they should probably not be in the Comments but in their own cells. Using color to code information is doing things the hard way.

I omitted the loop to support multiple formats in the comments for speed of exicution. If it is important, it will be mentioned.

Teacher5th
02-16-2008, 11:08 PM
Thanks guys. I opened a new 3 sheet WB, change one sheet to comments, inserted comments, copied updated code to VBA comments sheet, ran "Recordallsheetscomments" and it placed the comments on the comment sheet but then it bombed out at this location For Each oneCell In sourceSheet.Cells.SpecialCells(xlCellTypeComments)
i = i + 1 with an error Run time 1004 - application defined or object defined error - I feel you are so close- maybe I'm doing something wrong.

THanks again

Teacher5th
02-16-2008, 11:15 PM
Also, when I changed one of the comments in the A column, and want to update back to sheet 1 or 2 's comment cells, I ran the routine "update comments" and I get the same error as above at this line Range(oneCell.Offset(0, 1).Value).Comment.Text Text:=oneCell.Text

Could you send the spreadsheet again? thanks

mikerickson
02-16-2008, 11:29 PM
These versions of those two routines shouldn't bomb.
Sub UpdateComments()
Dim oneCell As Range, testCell As Range
Dim editCommentSheet As Worksheet
Dim i As Long
Application.ScreenUpdating = False

Set editCommentSheet = ThisWorkbook.Sheets("Comments")

With editCommentSheet
For Each oneCell In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set testCell = Nothing
On Error Resume Next
Set testCell = Range(oneCell.Offset(0, 1).Value)
On Error GoTo 0
If Not testCell Is Nothing Then
testCell.Comment.Text Text:=oneCell.Text
Call CellToComment(oneCell, testCell): Rem removable
End If
Next oneCell
End With
Application.ScreenUpdating = True
End Sub

Sub recordComments(sourceSheet As Worksheet)
Dim oneCell As Range, commentRange As Range
Dim editCommentSheet As Worksheet
Dim i As Long
Set editCommentSheet = ThisWorkbook.Sheets("Comments")
i = editCommentSheet.Range("A65536").End(xlUp).Row
If editCommentSheet.Cells(i, 1) = vbNullString Then i = i - 1
Application.ScreenUpdating = False
On Error Resume Next
Set commentRange = sourceSheet.Cells.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If commentRange Is Nothing Then Exit Sub
For Each oneCell In commentRange
If i < 0 Then i = 0
i = i + 1
editCommentSheet.Cells(i, 1).Value = oneCell.Comment.Text
Call commToCell(oneCell, editCommentSheet.Cells(i, 1)): Rem removable
editCommentSheet.Cells(i, 2) = oneCell.Parent.Name & "!" & oneCell.Address
Next oneCell
Application.ScreenUpdating = True
End Sub

gwkenny
02-16-2008, 11:47 PM
The arguments of Characters are similar to arguments for MID.

Ahh, I see, ".Shape.TextFrame.Characters(1, 1).Font.Size". Sneaky Microsoft!!! :D

Thanks, love learning stuff. Just hope I do not forget it when I need it!!! :D


I omitted the loop to support multiple formats in the comments for speed of exicution. If it is important, it will be mentioned.

Actually, it was mentioned in Teacher's first post, "hopefully, with a larger font and the colors I give to certain words." But I agree that it's a lot of work for little gain!

Teacher5th
02-17-2008, 09:13 AM
Thanks again. THat worked without giving an error message. I placed it in my large workbook and it pulled in ALL comments really fast an nice. I believe I'm suppose to run the Record macro to save it back but when I made a change in the comment sheet, it ran without errors but didn't save. So I tried it on a new 3 sheet xls and had the same problem there. I'm so appreciative for your efforts that I hate to give this news. But I hope you can do two things- see what the recording problem is and I just realized that I need one more thing - promise - with 134 comments, I realized that I couldn't tell what went where without going back to the actual cells. Could you insert a column displaying the cell value where the comment came from. I don't have to save the value back. THat would really be helpful.

Mikerickson - you reallly did a great job and I believe this code should be placed on the KB as I believe this is a much better way to maintain comments. THanks a lot!!!

mikerickson
02-17-2008, 11:54 AM
The designed sequence of user actions is:

run RecordAllSheetsComments
type changes to the Comments sheet
run UpdateComments

Running UpdateComments is not automatic.

About the cell addresses, column B of the "Comments" sheet is a list of the source cell addresses.

Teacher5th
02-17-2008, 12:04 PM
That is what I thought but I must be doing something wrong because it doesn't update back to the original comment when I run "update." I enclosed a simple WB so you can see what I'm missing. I saw the cell addresses and that is good but when you have 134 comments it is hard to remember which heading (cell value) each applies too without taking the time to go to that sheet and lookup the cell address. Is it just a matter of a few lines in the Record module to add column C what is in the cell that the comment is coming from?

Thanks again for your interest in my classroom!! - How can we give this to others because I'm sure that it is ten times better to maintain comments this way (spell check, etc)?

mikerickson
02-17-2008, 12:16 PM
EDIT: we simulposted. This will be easier after waffles and coffee.

If you put this in the code module for the "Comment" sheet, the comments will be updated as you type the changes.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim testCell As Range
If Target.Column * Target.Cells.Count = 1 Then
On Error Resume Next
Set testCell = Range(oneCell.Offset(0, 1).Value)
On Error GoTo 0
If Not (testCell Is Nothing) Then
Call CellToComment(Target, testCell)
End If
End If
End Sub

As I think about it, this may be a solution to the speed problem. If each change is recorded (automticaly) as it is entered, the slowness of the routine won't be recognized because the user is comparing it to the speed of human keystrokes. The routine is no faster but the time delay won't be percieved. (Its also possible that the little hesitation and tiny forced wait will be more annoying that a long wait after pressing a button.)

This may make multiple formats in a comment feasable. Let me know if you want the code tweaked.

Also, the RecordComments macro needs two more line to keep from triggering the new _Change event code.

Sub recordComments(sourceSheet As Worksheet)
Dim oneCell As Range, commentRange As Range
Dim editCommentSheet As Worksheet
Dim i As Long
Set editCommentSheet = ThisWorkbook.Sheets("Comments")
i = editCommentSheet.Range("A65536").End(xlUp).Row
If editCommentSheet.Cells(i, 1) = vbNullString Then i = i - 1
Application.ScreenUpdating = False

Application.EnableEvents = False

On Error Resume Next
Set commentRange = sourceSheet.Cells.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If commentRange Is Nothing Then Exit Sub
For Each oneCell In commentRange
If i < 0 Then i = 0
i = i + 1
editCommentSheet.Cells(i, 1).Value = oneCell.Comment.Text
Call commToCell(oneCell, editCommentSheet.Cells(i, 1)): Rem removable
editCommentSheet.Cells(i, 2) = oneCell.Parent.Name & "!" & oneCell.Address
Next oneCell

Application.EnableEvents = True

Application.ScreenUpdating = True
End Sub

Teacher5th
02-17-2008, 12:59 PM
I don't know what to say. You are so nice to stay so involved. I think that is a great idea to auto update as you type into the comment sheet. That is the best way: Once you run Record and bring them in, then change the comment there and it automatically changes the actual comment on sheet 1/2. (But then it is imperative that we add that extra column that has the cell's value so I don't change the wrong actual comment.)

I put your new code into that WB I sent to you but still am, I guess, not using it correctly since I can't get the update to place the changes on the Comment sheet back on sheet 1 or 2. Either auto like you mentioned above or by running "Update".

Could you enclose an actual XLS that has your code because I just can't get it to update?

I'm surprised but very happy that you are not leaving me hanging since we got this far. You are a nice guy. If you like, I can send you a newspaper article about this special classroom. email me at Sloan@cox.net.

Thanks again

mikerickson
02-17-2008, 03:27 PM
The auto routine I posted was untested and didn't work for me either. (Programming note: when in Sheet2's code module, the syntax Range("Sheet1!$A$1") errors.)

I fixed things up and altered the file you sent me. This file has the auto-update feature and the cell value column. Since very bad things happen when Column C is changed, I added a routine to forbid the user from selecting that column.

I also tightened a few things up and added some comments to the code.

Changing a cell's format, without changing the value, doesn't trigger the Worksheet_Change event. So, the AutoUpdate will not update if the only change is to format. (The UpdateAll button will do that.) AutoUpdate will update only when the text of the comment is changed (or re-typed). Any changes to format will be included with those updates.

One more thing, the file you sent me had the code in Sheet"Comments" 's code module. Usually, code goes in a normal module. In ThisWorkbook, sheet's code modules and userform code modules, I try to put only Event code (and dedicated functions/subroutines).

I'll PM you my e-mail.