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

 

[erik.van.geit]

Hi,

2 questions
this sounds like you are continuing a thread: do you have good reasons to start a new one ?
if so:
how do you define

comment that has changed since the last time i ran it

kind regards,
Erik

 

[centaur63]

Excel

Yeah, My Original question was answer from the last post. I needed to know how to get it to run again. Because each time i ran it it would overwrite the previous entries. You guys helped me get that part working. Now i need to eliminate all the extra parts i just want the comments that has changed inserted. I belived it to be a different question. If this is a problem that i started a new thred i will gladly go back to the otherone.

 

[erik.van.geit]

it's up to you to decide to start a new thread
it's the task of the admins to judge about it
I was only asking it to help you, since the guys who originally helped you would know more about it ...

still need an answer
how do you define

comment that has changed since the last time i ran it

probably a little sample will help

 

[centaur63]

Thanks

I appreciate you trying to help me. Do you have any clue how i can get this code to work??? Ive been trying to figure this out for a while now.

 

[erik.van.geit]

Re: Thanks

I appreciate you trying to help me. Do you have any clue how i can get this code to work??? Ive been trying to figure this out for a while now.

I really want to help but already asked more info twice: try answering the question: it might be a wrong question, but then explain what you are trying to do !

let's put it another way
your code is creating an extra sheet
  A   B                     C           D                                      
1                                       C:\WINDOWS\Desktop\Book1.xls -- Sheet1 
2                                                                              
3 A2: 11/09/06     20:54:35 contents A2 just some text in A2 comment           
4 A5: 11/09/06     20:54:35 typed in A5 just some text in A5 comment           

sheet2
[Table-It] version 06 by Erik Van Geit
what would you like to happen when running the code again ?

please be explicit using the example
if the example is not OK, then provide another one please

best regards,
Erik

 

[erik.van.geit]

I edited the code for better reading and maintenance
it does NOT do anything else then the one you posted, it's just a question of layout-functionality

Option Explicit

Private Sub PrintCommentsByColumn()
  
Dim wsSource As Worksheet
Dim wsNew As Worksheet
Dim cell As Range
Dim myUsedRange As Range
Dim myrangeC As Range
Dim col As Long
Dim RowOS As Long


    If ActiveSheet.Comments.Count = 0 Then
    MsgBox "No comments in active sheet", 48, "END CODE"
    Exit Sub
    End If
    
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wsSource = ActiveSheet
Set myUsedRange = wsSource.UsedRange

Sheets.Add
Set wsNew = ActiveSheet


    With wsNew
        With .Columns("A:D")
        .VerticalAlignment = xlTop
        .WrapText = True
        End With
    .Columns("B").ColumnWidth = 15
    .Columns("C").ColumnWidth = 15
    .Columns("D").ColumnWidth = 60
    .PageSetup.PrintGridlines = True
    .Cells(1, 4) = ActiveWorkbook.FullName & " -- " & wsSource.Name
    
        RowOS = 2

        For col = 1 To myUsedRange.Columns.Count
        Set myrangeC = Intersect(myUsedRange, wsSource.Columns(col), wsSource.Cells.SpecialCells(xlCellTypeComments))
            If Not myrangeC Is Nothing Then
                For Each cell In myrangeC
                    If Trim(cell.Comment.Text) <> "" Then
                    RowOS = RowOS + 1
                    .Cells(RowOS, 1) = "'" & cell.Address(0, 0) & ":"
                    .Cells(RowOS, 2) = "'" & Date & "     " & Time
                    .Cells(RowOS, 3) = "'" & cell.Text
                    .Cells(RowOS, 4) = "'" & cell.Comment.Text
                    End If
                Next cell
            End If
        Next col

    End With

wsNew.Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[centaur63]

Sorry

Ok, I just changed it where it points to a sheet called test. So what it does is insert all comment from the first worksheet into this worksheet called test. Then once the program runs again it then inserts this information again without overwriting the prevous entry. What I want it to do now is Only insert the comments that has changed sense the last time the program was ran. The code i just submitted is the updated one.

This is what I want to happen: When Code is ran the first time:

A B C D
Cell Changed date Changed Value Comment
j20 9/11/06 5 I was 6
j34 9/11/06 7 i was 22
j55 9/11/06 8 I was 9

Once this is inserted And i Run it again i only want the cells that changed to be inserted again like this:

A B C D
Cell Changed date Changed Value Comment
j20 9/11/06 5 I was 6
j20 9/11/06 8 I was 5
j34 9/11/06 7 i was 22
j55 9/11/06 8 I was 9

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 
  Set wsNew = Sheets("Test") 
  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 = wsNew.Range("A65536").End(xlUp).Row 
  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

Does this make sense?? If not i can explain more. Sorry again for not being more detailed. I thank you for your patience

 

[erik.van.geit]

OK,
I see now
we will put all cells at the end if the address is not found in the list
if the address is found and the comment has not changed it will be skipped
a sort at the end will put the lines together

would you mind having only the celladdresses without the ":" (don't see why you would need that)
it would enhance the process

 

[centaur63]

ok

No I dont mind at all having the celladdresses without the ":"