For Each Döngüsüne Not Eklemek

[tuvons]

Merhaba,

Aşağıda yazdığım döngüde kırmızıya boyadığı hücreye not eklemeye çalışıyorum ama bir türlü beceremedim. Yardımcı olabilir misiniz?

Sub Makro23()
'Olmaması gereken veri bak
Set S1 = Worksheets("Sayfa1")
Set S2 = Worksheets("VERİLER")

sonsatir1001 = S1.Range("B" & Rows.Count).End(xlUp).Row
sonsatir2001 = S2.Range("B" & Rows.Count).End(xlUp).Row

    For Each ara1 In S1.Range("B2:B" & sonsatir1001)
    Set kontrol1 = S2.Range("B2:B" & sonsatir2001).Find(ara1, LookIn:=xlValues)
    If kontrol1 Is Nothing _
    Then ara1.Interior.Color = vbRed _
    And ara1.AddComment("Boş Olmamalı")
    Next ara1
End Sub

 

[reosman]

Merhaba, Deneyiniz.

Sub Makro23()
On Error Resume Next
Set S1 = Worksheets("Sayfa1")
Set S2 = Worksheets("VERİLER")

sonsatir1001 = S1.Range("B" & Rows.Count).End(xlUp).Row
sonsatir2001 = S2.Range("B" & Rows.Count).End(xlUp).Row

    For Each ara1 In S1.Range("B2:B" & sonsatir1001)
    Set kontrol1 = S2.Range("B2:B" & sonsatir2001).Find(ara1, LookIn:=xlValues)
    If kontrol1 Is Nothing _
    Then ara1.Interior.Color = vbRed _
    And ara1.AddComment.Text = ("Boş Olmamalı")
    Next ara1
End Sub

 

[veyselemre]

Sub Makro23()
 
    Set S1 = Worksheets("Sheet1")
    Set S2 = Worksheets("Sheet2")

    sonsatir1001 = S1.Range("B" & Rows.Count).End(xlUp).Row
    sonsatir2001 = S2.Range("B" & Rows.Count).End(xlUp).Row

    For Each ara1 In S1.Range("B2:B" & sonsatir1001)
        With ara1
            Set kontrol1 = S2.Range("B2:B" & sonsatir2001).Find(.Value, LookIn:=xlValues)
            If kontrol1 Is Nothing Then
                .Interior.Color = vbRed
                If .Comment Is Nothing Then
                    .AddComment "Boş Olmamalı"
                Else
                    .Comment.Text "Boş Olmamalı"
                End If
            End If
        End With
    Next ara1
End Sub