Trying to get an input box to pop up so a user can enter a brief description that will then appear in a comment attached to the cell. The problem I believe I’m running into is the user inputs data into a table on one sheet (DataX) which feeds results over to another sheet (SheetX). It is the results in SheetX’s non-contiguous range where I’d like the comments to reside.
The cells on DataX are matched up to a cell to SheetX by a reference formula. For example, Cell D11 on DataX calculates the value. Cell B26 on SheetX references Cell D11 on DataX by using ='Data X'!D11.
The value test occurs through conditional formatting on SheetX using =AND(A1>0,A1<=0.989). If the value test is met the cell is highlighted red.
This is not really a 1:1 cell reference relationship ('Sheet'X!A1 references 'DataX'!A1) which may be the issue. It does work when it is a 1:1 cell reference relationship. For example, if ‘Sheet’!XB26 references ‘Data’!XB26 the input box pops up and the comment is created.
Also, might it be best to simply have the value test occur on DataX, create an input box to insert a comment there, and then perhaps have the designated cells in SheetX pull the comment in if applicable?
jski
The cells on DataX are matched up to a cell to SheetX by a reference formula. For example, Cell D11 on DataX calculates the value. Cell B26 on SheetX references Cell D11 on DataX by using ='Data X'!D11.
The value test occurs through conditional formatting on SheetX using =AND(A1>0,A1<=0.989). If the value test is met the cell is highlighted red.
This is not really a 1:1 cell reference relationship ('Sheet'X!A1 references 'DataX'!A1) which may be the issue. It does work when it is a 1:1 cell reference relationship. For example, if ‘Sheet’!XB26 references ‘Data’!XB26 the input box pops up and the comment is created.
Also, might it be best to simply have the value test occur on DataX, create an input box to insert a comment there, and then perhaps have the designated cells in SheetX pull the comment in if applicable?
Code:
'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 Subjski
