Insert Comments that has Changed Only(This is a tough one)

[centaur63]

Ok what i need to do with this code now is make it so that it only inserts the comment that has changed since the last time i ran it. Right now it keeps inserting the same cells over and over again. Can You please help me with this one!!!!

Private Sub PrintCommentsByColumn()
  
  Dim cell As Range
  Dim myrange As Range, myrangeC As Range
  Dim col As Long
  Dim RowOS As Long
  Dim wsSource As Worksheet
  Dim wsNew As Worksheet
  If ActiveSheet.Comments.Count = 0 Then
    MsgBox "No comments in entire sheet"
    Exit Sub
  End If
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set wsSource = ActiveSheet
  Sheets.Add
  Set wsNew = ActiveSheet
  wsSource.Activate
  With wsNew.Columns("A:D")
      .VerticalAlignment = xlTop
      .WrapText = True
  End With
  wsNew.Columns("B").ColumnWidth = 15
  wsNew.Columns("C").ColumnWidth = 15
  wsNew.Columns("D").ColumnWidth = 60
  wsNew.PageSetup.PrintGridlines = True
  RowOS = 2
  wsNew.Cells(1, 4) = "'" & Application.ActiveWorkbook.FullName & " -- " & _
      Application.ActiveSheet.Name
  For col = 1 To ActiveSheet.UsedRange.Columns.Count
     Set myrangeC = Intersect(ActiveSheet.UsedRange, Columns(col), _
         Cells.SpecialCells(xlCellTypeComments))
     If myrangeC Is Nothing Then GoTo nxtCol
     For Each cell In myrangeC
        If Trim(cell.Comment.Text) <> "" Then
           RowOS = RowOS + 1
           wsNew.Cells(RowOS, 1) = "'" & cell.Address(0, 0) & ":"
           wsNew.Cells(RowOS, 2) = "'" & Date & "     " & Time
           wsNew.Cells(RowOS, 3) = "'" & cell.Text
           wsNew.Cells(RowOS, 4) = "'" & cell.Comment.Text
        End If
     Next cell
nxtCol:
  Next col
  wsNew.Activate
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

 

[centaur63]

tHANKS

thanks again. When i get back to work i will do excatly that.