A couple of months ago a colleague moved into a new position at work and inherited a big ugly spreadsheet. Happens to the best of us, amiright? The biggest challenge with this spreadsheet is that the previous owner, who has since retired (and good for him!) didn’t update his status notes and comments in a cell or a column. He kept them all in in-cell comments.

In. Comments.

Needless to say, the spreadsheet my colleague inherited had a couple of billion comments, some of which were absolutely enormous. She wanted to know if there was a quick way to extract all of the text out of the comments, and put them in the first available cell to the right. And if the old comments could be deleted as part of the extraction, that would be a bonus.

To which I said, of course that can be done!

And so, I wrote this little routine as a way of pulling the text from comments, placing it in the first available cell to the right, and blowing away the old comments if desired. Enjoy!

Sub ExtractComments()
'*******************************************************************************
' Description:  This iterates through all of the used cells in a worksheet
'               and where comments exist, extracts them and places them
'               in the next free cell to the right in the row where the
'               comment exists.
'
' Author:       Scott Lyerly
' Contact:      scott.c.lyerly@gmail.com
'
' Notes:        None.
'
' Arguments:    None
'
' Returns:      None
'
' Change Log:
' Name:                 Date:           Init:   Modification:
'---------------------------------------------------------------------
' ExtractComments V1    10-APR-2015     SCL     Original development
'
'*******************************************************************************
On Error GoTo ErrorHandler

' Variable declarations.
Dim sh          As Worksheet
Dim rng         As Range
Dim rCell       As Range
Dim rComments   As Range
Dim lAns        As Long
Dim lCalc       As Long

' Set some references to the active sheet and the sheet's used range.
Set sh = ActiveSheet
Set rng = sh.UsedRange

' Check to see if there are any comments in the sheet.
Set rComments = rng.SpecialCells(xlCellTypeComments)
If rComments Is Nothing Then GoTo Exit_Clean

' Ask user if they want to delete the comments as they are extracted.
lAns = MsgBox("Do you want to delete the comments as they are extracted?", vbYesNo + vbQuestion)

' Speed up the processing time.
With Application
lCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

' Iterate through the used range and where there are comments,
' extract their text and add it to the row.
For Each rCell In rng
If Not Intersect(rCell, rComments) Is Nothing Then
sh.Cells(rCell.Row, sh.Range("XFD" & rCell.Row).End(xlToLeft).Column + 1).Value = rCell.Comment.Text
' If the user selected YES above, delete the comments.
If lAns = vbYes Then rCell.Comment.Delete
End If
Next rCell

Exit_Clean:

' Restore the environment.
With Application
.Calculation = lCalc
.ScreenUpdating = True
End With

' Delete objects to memory.
Set sh = Nothing
Set rng = Nothing
Set rComments = Nothing

Exit Sub

ErrorHandler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Clean

End Sub