Question about modifying a specific VBA code

[Praxis84]

I am building a an excel document that requires me to print from the comments of the cells. I have found the following formula that does print successfully, but I need it to print only the column I have selected. Each Column has a specific date at the top which could be selected as a prompt.

Additionally, Are there ways of counting the lines or values in a comment and have it updated to the cell it is commenting on?

Code:

Public Sub Print_Students()
Dim Cmt As String
Dim C As Range
Dim I As Integer
Dim WordObj As Object
Dim ws As Worksheet
Dim PrintValue As Boolean
Dim res As Integer
On Error Resume Next
Err.Number = 0
res = MsgBox("Do want to print cell values with comments?", _
vbYesNoCancel + vbQuestion, "Print Cell Comments")
Select Case res
Case vbCancel
Exit Sub
Case vbYes
PrintValue = True
Case Else
PrintValue = False
End Select
Set WordObj = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set WordObj = CreateObject("Word.Application")
Err.Number = 0
End If
WordObj.Visible = True
WordObj.Documents.Add
With WordObj.Selection
.TypeText Text:="Cell Comments In Workbook: " + ActiveWorkbook.Name
.TypeParagraph
.TypeText Text:="Date: " + Format(Now(), "dd-mmm-yy hh:mm")
.TypeParagraph
.TypeParagraph
End With
For Each ws In Worksheets
For I = 1 To ws.Comments.Count
Set C = ws.Comments(I).Parent
Cmt = ws.Comments(I).Text
With WordObj.Selection
.TypeText Text:="Comment In Cell: " + _
C.Address(False, False, xlA1) + " on sheet: " + ws.Name
If PrintValue = True Then
.TypeText Text:=" Cell Value: " + Format(C.Value)
End If
.TypeParagraph
.TypeText Text:=Cmt
.TypeParagraph
.TypeParagraph
End With
Next I
Next ws
Set WordObj = Nothing
MsgBox "Finished Printing Comments To Word", vbInformation, _
"PrintCellComments"
End Sub

 

[Praxis84]

No responses at all?

 

[John_w]

This pretty much covers your questions; you just need to incorporate it into your own code. I'm not sure exactly what "have it updated to the cell it is commenting on" entails, but I've taken a stab at this too.

Sub cloop()
    
    Dim cell As Range
    Dim cellComment As String
    Dim lines As Variant
        
    If Selection.Columns.Count > 1 Then
        MsgBox "More than one column is selected.  Please select rows in only one column, or an entire column."
        Exit Sub
    End If
    
    'Display contents of cell at top of selected column
    MsgBox "Column header = " & Cells(1, Selection.Column).Value
    
    'Loop through each cell in selection
    For Each cell In Selection
        'Does this cell contain a comment?
        If Not cell.Comment Is Nothing Then
            'Yes, so split into separate lines so that number of lines can be counted
            cellComment = cell.Comment.Text
            lines = Split(cellComment, Chr(10))
            MsgBox prompt:=cell.Value & vbNewLine & cellComment & vbNewLine & "Lines = " & UBound(lines) + 1, Title:="Comment in cell " & cell.Address(False, False)
            'And update the cell
            cell.Value = UBound(lines) + 1 & " lines in comment"
        End If
    Next

End Sub