comment via VBA met loop

[popipipo]

In bijgaand bestand werkt meerdere commentaren achter elkaar toevoegen aan één cel prima.
Als het echter om meerdere cellen gaat en ik het in een loop zet (For each cell in range... next ) dan worden alle commentaren in 1 cel gezet.
Mijn verwachting was is en bedoeling is dat in elke cel zijn eigen commentaar gezet wordt.
Is de cel leeg dan moet er ook geen commentaar aangemaakt worden.

 

[HSV]

Ik heb de code zoveel mogelijk in takt gehouden, zodat je het verschil ziet Willem.

Sub Add_Comment()

    Dim strDate As String
    Dim cmt As Comment
    strDate = "dd-mmm-yy hh:mm"
    
    Set rRng = Sheet1.Range("test")
  
  
For Each rcell In rRng.SpecialCells(2)           
Set cmt = rcell.Comment
             If cmt Is Nothing Then
               Set cmt = rcell.AddComment
               
             cmt.Text rcell & WorksheetFunction.VLookup(rcell, Range("N8:O11"), 2, 0) & Chr(10) & "Door: " & Environ("username") & "     Op: " & Format(Now, strDate)
                 With cmt.Shape.TextFrame
                     .Characters(1, lBreak).Font.ColorIndex = 3
                     .Characters(Len(rcell & WorksheetFunction.VLookup(rcell, Range("N8:O11"), 2, 0) & Chr(10) & "Door: " & Environ("username") & "     Op: " & Format(Now, strDate)) + 1).Font.ColorIndex = 1
                 End With
             
             
             Else
             cmt.Text rcell & WorksheetFunction.VLookup(rcell, Range("N8:O11"), 2, 0) & Chr(10) & "Door: " & Environ("username") & "     Op: " & Format(Now, strDate) & Chr(10) & Chr(10) & cmt.Text
                 With cmt.Shape.TextFrame
                     .Characters(1, lBreak).Font.ColorIndex = 3
                     .Characters(Len(ActiveCell.Value & WorksheetFunction.VLookup(rcell, Range("N8:O11"), 2, 0) & Chr(10) & "Door: " & Environ("username") & "     Op: " & Format(Now, strDate)) + 1).Font.ColorIndex = 1
                 End With
             
                  cmt.Shape.TextFrame.AutoSize = True
            End If
   
Next rcell           
    
End Sub

 

[popipipo]

Het scheelde niet veel of ik had het goed.

Maar ja bijna goed is helemaal fout

merci!!

 

[snb]

Een andere benadering:
- reduceer de interaktie met het werkblad tot een minimum
- gebruik unieke 'identifiers': ik verving 'vv' door een 'w'
- sla in variabelen op wat je nodig hebt, in VBA een vlookupformule gebruiken is niet voor de hand liggend.
- standaard is de lettrertypekleur van een commentaar colorindex 1; die hoef je dan niet nogeens te gebruiken in de code
- omdat de variabele lbreak nergens stond gedefinieerd heb ik verondersteld dat het om de inhoud van de cel ging.

Sub M_snb()
    On Error Resume Next
    sn = Range("O8:O11")
  
   For Each cl In Sheet1.Range("test").SpecialCells(2)
     y = cl.Comment
     If Err.Number <> 0 Then cl.AddComment
     Err.Clear
   Next
   On Error GoTo 0
   
   For Each cl In Sheet1.Range("test").SpecialCells(-4144)
      With cl.Comment
        .Text cl.Value & sn(InStr("ivwx", cl.Value), 1) & Chr(10) & Environ("username") & vbLf & Format(Now, "dd-mmm-yy hh:mm")
        .Shape.TextFrame.Characters(1, Len(cl.Value)).Font.ColorIndex = 3
      End With
   Next
End Sub

 

[popipipo]

@snb

Ik heb eerlijk gezegd niet naar jou oplossing gekeken.
Ten eerste had ik de vraag al als opgelost gezet.
Ten tweede bleek bij nader testen dat het toch niet zo handig was om het op deze manier te doen.
Toch bedankt voor je reactie.