Create Comment With Input Box

[jski21]

Trying to get an input box to pop up so a user can enter abrief comment that will then appear in a comment attached to the cell. Theproblem I believe I’m running into is the user inputs data into a table on onesheet which feeds results over to another sheet; Sheet X. It is the results in SheetX’s range where I’d like the comments to reside. I think I need to specifySheet X in the range below to get this to work?


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

'`````````````````````````````````````````````````````'
'Create pop up input box and add comment if"<=98.9%" result'
Dim sReason AsString


If NotIntersect(Target,Range("$B$26:$B$28,$B$30:$B$32,$B$34:$B$36,$B$38:$B$40,$E$26:$E$28,$E$30:$E$32,"& _
"$E$34:$E$36,$E$38:$E$40,$J$26:$J$28,$J$30:$J$32,$J$34:$J$36,$J$38:$J$40,"& _
"$M$26:$M$28,$M$30:$M$32,$M$34:$M$36,$M$38:$M$40")) Is NothingThen
IfTarget.Value > 0 <= 0.989 Then
sReason =Application.InputBox("Please provide a brief comment on why KPI wasmissed", Type:=2)
Target.AddComment
Target.Comment.Visible = False
Target.Comment.Text Text:=sReason
End If
End If

Application.ScreenUpdating = True

End Sub



Thanks


jski

 

[rlv01]

Yes, I think that helps. Here is how I understand your answer:

1. The cells on Data X are matched up to a cell to Sheet X by a reference formula. For example, Cell A1 on Data X calculates the value. Cell A1 on Sheet X references Cell A1 on Data X by using ='Data X'!A1.

So that means there is a 1 to 1 correspondence for cell addresses. In other words, if the user enters data in Data X Cell A1 then the new comment (if required) must go on Sheet X Cell A1

2. The value test occurs through conditional formatting on Sheet X using =AND(A1>0,A1<=0.989). If the value test is met the cell is highlighted red.

Then the cell A1 value you are using for the value test above, is on Sheet X, and not on on Data X

 

[rlv01]

'This sub is located in the Sheet "Data X" code module.
Private Sub Worksheet_Change(ByVal Target As Range)
'`````````````````````````````````````````````````````'
'Create pop up input box and add comment if"<=98.9%" result'
    Dim sReason As String
    Dim WS As Worksheet
    Dim C As Comment
    Dim rng As Range
    
    If Not Intersect(Target, Me.Range("$B$26:$B$28,$B$30:$B$32,$B$34:$B$36,$B$38:$B$40,$E$26:$E$28,$E$30:$E$32," & _
                                      "$E$34:$E$36,$E$38:$E$40,$J$26:$J$28,$J$30:$J$32,$J$34:$J$36,$J$38:$J$40," & _
                                      "$M$26:$M$28,$M$30:$M$32,$M$34:$M$36,$M$38:$M$40")) Is Nothing Then

        Set WS = ThisWorkbook.Worksheets("Sheet X")
        Set rng = WS.Range(Target.Address)
        Set C = rng.Comment
        If Not C Is Nothing Then
            C.Delete                                  'delete any existing comment
        End If

        If rng.Value > 0 And rng.Value <= 0.989 Then
            Do
                sReason = Application.InputBox("Please provide a brief comment on why KPI was missed", _
                                               Title:="Comment for cell " & rng.Address & " (in " & WS.Name & ")", Type:=2)
            Loop Until sReason <> "False"
            rng.AddComment
            rng.Comment.Visible = False
            rng.Comment.Text Text:=sReason
        End If
    End If

    Application.ScreenUpdating = True
End Sub

 

[jski21]

Gave this a shot but nothing occurred?

 

[jski21]

Not really a 1:1 reference relationship:

Cell B26 in Sheet X is a reference to ='Data X'!I11. CellB26 in Sheet X contains the conditional formatting of =AND(B26>0,B26<=0.989)as do all the cells in the Me.Range.

Data X I11 is a calculated result.

Maybe need to specify the calculated result range in Data X?

 

[rlv01]

I tested it on my own sheets "Data X" and "Sheet X" and it works fine. But of course it is based on your explanations and your answers to my earlier questions. Since your most recent post has contradicted those earlier answers and introduced some new and previously unmentioned elements, it follows that I don't have a good understanding of what you trying to do or how to help you do it, so I'll just wish you well and bow out here.

 

[jski21]

Fully understand and sincerely appreciate the time and effort. What's been provided here by you and mikerickson has been very instructive and helpful. I will follow up on this post for others when I finish the project.