Floating Comments Only Show One Comment

[CrispyAsian]

Hello all,

Having an issue with floating comments. I have a code that pulls in peoples names from a dynamic number of sheets and then incorporates them into a comment. However when I look at the comments, it only has one name, which is the last one it entered. Can someone tell me what I'm doing wrong here? (BTW, I'm still a noob so forgive how terrible this code looks):

Sub Percentages()


Sheets("Sheet1").Range("M1:S100").Clear


Worksheets("Sheet1").Range("D3:J3").Copy Worksheets("Sheet1").Range("M3")


Range("N:O").Merge (True)


Dim searchedID As Variant, cell As Range, rowinsheet1 As Long, allrows As Long, ID As Variant, d As Range
allrows = Sheets("Sheet1").Range("M4:M100").Row
rowinsheet1 = Sheets("Sheet1").Cells(Rows.Count, "M").End(xlUp).Row + 1
If rowinsheet1 < 2 Then rowinsheet1 = 2


Do


For Each ws In ThisWorkbook.Worksheets
   If ws.Name <> "Document map" And ws.Name <> "Sheet1" Then
        For Each c In ws.Range("D4:D40")
            If c <> "" Then
                ID = ws.Cells(c.Row, "D").Value
                   For Each d In Worksheets("Sheet1").Range("M4:M100")
                        If Worksheets("Sheet1").Cells(d.Row, "M").Value = ID Then
                            GoTo Line1
                        ElseIf Worksheets("Sheet1").Cells(d.Row, "M").Value <> ID And Worksheets("Sheet1").Cells(d.Row, "M").Value <> "" Then
                            GoTo Line2
                        ElseIf Worksheets("Sheet1").Cells(d.Row, "M").Value <> ID And Worksheets("Sheet1").Cells(d.Row, "M").Value = "" Then
                        searchedID = ID
                        End If
Line2:
                    Next d
            End If
Line1:
        Next c
    End If
Next ws






rowinsheet1 = rowinsheet1 + 1


For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Document map" And ws.Name <> "Sheet1" Then
  Set cell = ws.Columns("D:D").Find(what:=searchedID, lookat:=xlWhole, LookIn:=xlValues)
    If Not cell Is Nothing Then
    Dim numbertoaddP As Integer, numbertoaddQ As Integer, numbertoaddR As Integer,[COLOR=#ff0000] commentname As String, oldcomment As Variant[/COLOR]
    numbertoaddP = ws.Cells(cell.Row, "G").Value
    numbertoaddQ = ws.Cells(cell.Row, "H").Value
    numbertoaddR = ws.Cells(cell.Row, "I").Value
[COLOR=#ff0000]    commentname = ws.Cells(cell.Row, "C").Value[/COLOR]
    With ThisWorkbook.Worksheets("Sheet1")
           .Cells(rowinsheet1 - 1, "P").Value = Worksheets("Sheet1").Cells(rowinsheet1 - 1, "P").Value + numbertoaddP
           .Cells(rowinsheet1 - 1, "Q").Value = Worksheets("Sheet1").Cells(rowinsheet1 - 1, "Q").Value + numbertoaddQ
           .Cells(rowinsheet1 - 1, "R").Value = Worksheets("Sheet1").Cells(rowinsheet1 - 1, "R").Value + numbertoaddR
    End With
      If Cells(rowinsheet1, "M") <> searchedID Then
      ws.Cells(cell.Row, "D").Copy Sheets("Sheet1").Cells(rowinsheet1 - 1, "M")
      ws.Cells(cell.Row, "E").Resize(1, 2).Copy Sheets("Sheet1").Cells(rowinsheet1 - 1, "N").Resize(1, 2)
[COLOR=#ff0000]      With Worksheets("Sheet1").Cells(rowinsheet1 - 1, "N")[/COLOR]
[COLOR=#ff0000]            On Error Resume Next[/COLOR]
[COLOR=#ff0000]            oldcomment = .Comment.Text[/COLOR]
[COLOR=#ff0000]            If oldcomment Is Nothing Then[/COLOR]
[COLOR=#ff0000]                .AddComment "Has RAP Event"[/COLOR]
[COLOR=#ff0000]                .Comment.Text Text:=commentname[/COLOR]
[COLOR=#ff0000]            Else[/COLOR]
[COLOR=#ff0000]                .Comment.Text Text:=oldcomment & ", " & commentname[/COLOR]
[COLOR=#ff0000]            End If[/COLOR]
[COLOR=#ff0000]        End With[/COLOR]
     End If
    End If
  End If
Next ws


Loop Until Worksheets("Sheet1").Cells(rowinsheet1 - 1, "M").Value = Worksheets("Sheet1").Cells(rowinsheet1 - 2, "M").Value


    Worksheets("Sheet1").Range(Cells(rowinsheet1 - 1, "M"), Cells(rowinsheet1 - 1, "R")).Clear
    
End Sub

I have highlighted the section I'm having trouble with. If anyone can provide any insight I would greatly appreciate it!

 

[daverunt]

I can't figure it out from looking at the code, but it might be that the value of 'oldcomment' is being retained into the next iteration of the loop.
The best way is to step through your code using the F8 key to confirm the values in the variables are as expected.

End If

oldcomment=""

Next ws