Copy Comments To Worksheet

[goss]

Hi All,

Using Excel 2010

I am trying to loop through worksheets and copy comments to a comment worksheet
I have a logic error because the code is picking up the first comment correctly but then continues assigning the first comment to incorrect worksheets until the next comment is found on the 9th worksheet

There are on 2 comments in the workbook at the moment on sheets 1z and 9z
So I should only have the two rows on my comments sheet (Currently retuning 26)

I thought this line would cause code execution to go to the next ws w/o adding a line to the comment sheet, but a line is still being added

If Not rngComm Is Nothing Then

Thoughts/comments?

Option Explicit

Sub RunComments2()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsComments As Worksheet
    Dim oCom As Comment
    Dim rngComm As Range ' Range of Possible Comments
    Dim cComm As Range 'Cell Comment
    Dim strVal As String 'Pass Comment to String Variable
    Dim lngRows As Long
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    
    Set wb = ThisWorkbook
    Set wsComments = wb.Worksheets("Comments")

    With wb
        On Error Resume Next
        For Each ws In .Worksheets
            If InStr(ws.Name, "x") Or _
                    InStr(ws.Name, "z") Then
                    With ws
                        .Activate
                        With ActiveSheet
                            Set rngComm = ws.Cells.SpecialCells(xlCellTypeComments)
                            If Not rngComm Is Nothing Then
                                For Each cComm In rngComm
                                    With wsComments
                                        lngRows = .Range("A65536").End(xlUp).Row + 1
                                        On Error Resume Next
                                        .Cells(lngRows, 1).Value = ws.Name
                                        .Cells(lngRows, 2).Value = cComm.Address
                                        .Cells(lngRows, 3).Value = cComm.Name.Name
                                        .Cells(lngRows, 4).Value = cComm.Value
                                        .Cells(lngRows, 5).Value = cComm.Comment.Text
                                        .Cells(lngRows, 6).Value = Now()
                                    End With
                                Next cComm
                            End If
                        End With
                    End With
            End If
        Next ws
    End With
 
    'Cleanup
        Set wb = Nothing
        Set ws = Nothing
        Set wsComments = Nothing
        Set oCom = Nothing
        Set rngComm = Nothing
        Set cComm = Nothing
 
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
            .DisplayAlerts = False
        End With
End Sub

 

[PA HS Teacher]

Try Setting your special cells reference to nothing as you loop through each sheet.

i.e.

For Each ws In .Worksheets
Set rngComm = Nothing

 

[JoeMo]

Also, since you have dimensioned cComm as a range, the statement:

.Cells(lngRows, 3).Value = cComm.Name.Name

will generate an error that will be bypassed b/c you have included an earlier On Error Resume Next. The net result will be an empty column C on the comments sheet. If that's not what you want, you need to remove or change this statement.