Copy Comments To Worksheet

goss

Active Member
Joined
Feb 2, 2004
Messages
372
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
Code:
If Not rngComm Is Nothing Then

Thoughts/comments?

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

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

PA HS Teacher

Well-known Member
Joined
Jul 17, 2004
Messages
2,838
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

MrExcel MVP
Joined
May 26, 2009
Messages
17,193
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Also, since you have dimensioned cComm as a range, the statement:
Code:
.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.
 

Watch MrExcel Video

Forum statistics

Threads
1,108,630
Messages
5,523,991
Members
409,554
Latest member
denistrevisan

This Week's Hot Topics

Top