On Error Resume Next
Dim c As Range, d As Range
Set d = Intersect(Target, Range("A:A"))
If d Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each c In d
c.Comment.Delete
Select Case UCase(c)
Case "KM-1": c.AddComment "Develop/Launch Comms Campaign"
Case "KM-2": c.AddComment "Identify/Engage Advocacy Groups"
Case "KM-3": c.AddComment "Identify Ways to Sustain Sharing Behavior"
Case "KM-4": c.AddComment "Define/Cultivate Roles for SLT & Admins"
Case "KM-5": c.AddComment "Create Onboarding KM Training"
Case "KM-6": c.AddComment "Develop/Deploy iManage"
Case "KM-7": c.AddComment "Develop/Deploy Portal (MVPs)"
Case "KM-8": c.AddComment "Develop/Deploy TeamConnect"
Case "KM-9": c.AddComment "Implement KM Analytics"
Case "KM-10": c.AddComment "Identify/Gather Knowledge Collections"
Case "KM-11": c.AddComment "Identify/Fill Knowledge Gaps"
Case "KM-12": c.AddComment "Create Knowledge Curation Process"
Case "KM-13": c.AddComment "Develop Internal Knowledge Resources"
Case "KM-14": c.AddComment "Establish/Measure Metrics for Success"
Case "KM-15": c.AddComment "Improve Knowledge Tools Continuously"
Case "KM-16": c.AddComment "Keep KM Program Vital"
End Select
Next
Application.EnableEvents = True
End Sub