Sheet code for input box and comment when cell contains certain value

[MeaclH]

Hi all,
Just need some quick help if possible. Am after a sheet code that will, when a cell value is changed to contain a "?" anywhere in the cell, will prompt a input box that the user must enter a comment which will then be applied to that cell as a comment.
Also, imptorantly, it must add the comment to any previous comments on that cell, rather than over write it.
Also, appreciate it the code has the option for me to name the input box with a title.

Appreciate your help.

Hayden

 

[Peter_SSs]

This is extremely close to this question you already asked.
Is there a particular range of cells this time or do you mean any cell anywhere on the worksheet?

 

[MeaclH]

This is extremely close to this question you already asked.
Is there a particular range of cells this time or do you mean any cell anywhere on the worksheet?

Hi Peter,
Yes I was worried how that might look.
I can't seem to figure out how to amend your other code for this instance. There would be a range of cells this would have to apply to yes.
Sorry to be a pain.
Thanks,
Hayden

 

[Peter_SSs]

I am assuming this is a different sheet. It it is the same sheet and you want the previous code and this code to work, you will need to post back for a combination of the codes if you cannot do that yourself.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Resp As String
  
  If Target.CountLarge = 1 And Not Intersect(Target, Range("F2:F20")) Is Nothing Then '<- Set relevant range in this line
    With Target
      If InStr(1, .Value, "?") > 0 Then
          Resp = Application.InputBox("Enter your comment", "This is the input box title", , , , , , 2)
          If Len(Resp) > 0 And Resp <> "False" Then
            If .Comment Is Nothing Then
              .AddComment Text:=Resp
            Else
              .Comment.Text .Comment.Text & vbLf & Resp
            End If
          End If
      End If
    End With
  End If
End Sub

 

[MeaclH]

I am assuming this is a different sheet. It it is the same sheet and you want the previous code and this code to work, you will need to post back for a combination of the codes if you cannot do that yourself.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Resp As String
 
  If Target.CountLarge = 1 And Not Intersect(Target, Range("F2:F20")) Is Nothing Then '<- Set relevant range in this line
    With Target
      If InStr(1, .Value, "?") > 0 Then
          Resp = Application.InputBox("Enter your comment", "This is the input box title", , , , , , 2)
          If Len(Resp) > 0 And Resp <> "False" Then
            If .Comment Is Nothing Then
              .AddComment Text:=Resp
            Else
              .Comment.Text .Comment.Text & vbLf & Resp
            End If
          End If
      End If
    End With
  End If
End Sub

Hey Peter....it's the same sheet. Was hoping to have them both run. If you dont min'd combining them please?

Thanks
Hayden

 

[Peter_SSs]

They just need to go into a single change event code.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Resp As String
  
  If Target.CountLarge = 1 And Not Intersect(Target, Range("C2:C10")) Is Nothing Then
    With Target
      Select Case .Value
        Case "b", "d", "f" '<- Add more trigger values here if required
          Resp = Application.InputBox("Enter your comment", , , , , , , 2)
          If Len(Resp) > 0 And Resp <> "False" Then
            If Not .Comment Is Nothing Then
              .Comment.Text .Comment.Text & vbLf & Resp
            Else
              .AddComment Text:=Resp
            End If
          End If
      End Select
    End With
  End If
  
  If Target.CountLarge = 1 And Not Intersect(Target, Range("F2:F20")) Is Nothing Then '<- Set relevant range in this line
    With Target
      If InStr(1, .Value, "?") > 0 Then
          Resp = Application.InputBox("Enter your comment", "This is the input box title", , , , , , 2)
          If Len(Resp) > 0 And Resp <> "False" Then
            If .Comment Is Nothing Then
              .AddComment Text:=Resp
            Else
              .Comment.Text .Comment.Text & vbLf & Resp
            End If
          End If
      End If
    End With
  End If
End Sub

 

[MeaclH]

They just need to go into a single change event code.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Resp As String
 
  If Target.CountLarge = 1 And Not Intersect(Target, Range("C2:C10")) Is Nothing Then
    With Target
      Select Case .Value
        Case "b", "d", "f" '<- Add more trigger values here if required
          Resp = Application.InputBox("Enter your comment", , , , , , , 2)
          If Len(Resp) > 0 And Resp <> "False" Then
            If Not .Comment Is Nothing Then
              .Comment.Text .Comment.Text & vbLf & Resp
            Else
              .AddComment Text:=Resp
            End If
          End If
      End Select
    End With
  End If
 
  If Target.CountLarge = 1 And Not Intersect(Target, Range("F2:F20")) Is Nothing Then '<- Set relevant range in this line
    With Target
      If InStr(1, .Value, "?") > 0 Then
          Resp = Application.InputBox("Enter your comment", "This is the input box title", , , , , , 2)
          If Len(Resp) > 0 And Resp <> "False" Then
            If .Comment Is Nothing Then
              .AddComment Text:=Resp
            Else
              .Comment.Text .Comment.Text & vbLf & Resp
            End If
          End If
      End If
    End With
  End If
End Sub

Peter! You are a legend. If I could shout you a pint down at the Star Hotel I would.
I have posted another question in regards to another solution I am looking for that may be XLOOKUP. Feel free to have a look and I'll chuck in a parma too

Cheers mate,
Hayden

 

[Peter_SSs]

Glad it worked for you.

If I could shout you a pint down at the Star Hotel I would.

Let me know when you are in the area.