Comments based on criteria

[desuth]

I found this VBA on how to make it where comments are based on certain criteria, but i need it to do just a bit more and i am stumped. What i need it to do is to pick out a cell value for a range in column A and put the comment in the cell of the same row in column G. I need it to do this for 1000 rows.
Below is the code i have found that needs a modification.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim c As Comment

    On Error GoTo haveError

    'see if any changes are in the monitored range...
    Set rng = Application.Intersect(Target, Me.Range("C2"))

    If Not rng Is Nothing Then
    'Next line prevents code updates from re-triggering this...
    '  (Not really needed if you're only adding comments)
        Application.EnableEvents = False
        For Each cell In rng.Cells
               If cell.Value = "Croatia" Then
                   Set rng = ActiveSheet.Cells(4, 3)
                   If Not (rng.Comment Is Nothing) Then rng.Comment.Delete
                   cell.Offset(2, 0).AddComment "Happy is as happy does"
                   'cell.Offset(0, 2).AddComment "fi"
                   'cell.Offset(0, 3).AddComment "fo"
               End If
              
               If cell.Value = "France" Then
                   Set rng = ActiveSheet.Cells(4, 3)
                   If Not (rng.Comment Is Nothing) Then rng.Comment.Delete
                   cell.Offset(2, 0).AddComment "Maybe yes"
                   'cell.Offset(0, 2).AddComment "fi"
                   'cell.Offset(0, 3).AddComment "fo"
               End If
              
               If cell.Value = "Spain" Then
                   Set rng = ActiveSheet.Cells(4, 3)
                   If Not (rng.Comment Is Nothing) Then rng.Comment.Delete
                   cell.Offset(2, 0).AddComment "Probably no"
                   'cell.Offset(0, 2).AddComment "fi"
                   'cell.Offset(0, 3).AddComment "fo"
               End If
              
                   For Each c In ActiveSheet.Comments
                     c.Visible = False
                   Next
              
            Next
       
        Application.EnableEvents = True
    End If
    Exit Sub

haveError:
    MsgBox Err.Description
    Application.EnableEvents = True

End Sub

 

[desuth]

Sounds great thank you for all of your help

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. I have used a,b,c and d for the aircraft names (in red) and beside each aircraft name is the comment associated with that aircraft (in blue). You will have to change the array of aircraft names and comments to match your actual names and comments. You will have to include all the aircraft names and associated comments in the array. If in future you add or remove names and comments, the array will have to be manually changed to reflect those changes. Close the code window to return to your sheet. You will be able to add one aircraft name at a time or copy/paste multiple aircraft names in column A. I hope this makes sense.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim arr As Variant, i As Long, rng As Range
    arr = Array("a", "a is good", "b", "b is bad", "c", "c is fair", "d", "d is OK")
    For Each rng In Target
        For i = LBound(arr) To UBound(arr) Step 2
            If rng = arr(i) Then
                If Not Range("D" & rng.Row).Comment Is Nothing Then Range("D" & rng.Row).Comment.Delete
                Range("D" & rng.Row).AddComment arr(i + 1)
                Exit For
            End If
        Next i
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[desuth]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. I have used a,b,c and d for the aircraft names (in red) and beside each aircraft name is the comment associated with that aircraft (in blue). You will have to change the array of aircraft names and comments to match your actual names and comments. You will have to include all the aircraft names and associated comments in the array. If in future you add or remove names and comments, the array will have to be manually changed to reflect those changes. Close the code window to return to your sheet. You will be able to add one aircraft name at a time or copy/paste multiple aircraft names in column A. I hope this makes sense.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim arr As Variant, i As Long, rng As Range
    arr = Array("a", "a is good", "b", "b is bad", "c", "c is fair", "d", "d is OK")
    For Each rng In Target
        For i = LBound(arr) To UBound(arr) Step 2
            If rng = arr(i) Then
                If Not Range("D" & rng.Row).Comment Is Nothing Then Range("D" & rng.Row).Comment.Delete
                Range("D" & rng.Row).AddComment arr(i + 1)
                Exit For
            End If
        Next i
    Next rng
    Application.ScreenUpdating = True
End Sub

works like a champ thank you!!!!

 

[mumps]

You are very welcome.