Double Click on linked cell to edit the comments & save in the same cell.

[ashyn]

Hello Everyone,
I work as part of a hotel & am trying to work on a report.

Please can someone help me find an answer.
I have a table with Column C where employees assigned this task put in comments on a daily basis.

I review this report & make changes if any before the report is shared to mt Boss.
The comments are very important for decisions to be made.

Is there a Macro that can help me on this ? Can i do the changes to the comment when I double click ?

SHEET 1	Coulmn A	Column B	Column C	ColumnD
Row 1	Unit	Trend	Comments
Row 2	Reception	Upwards	10 Regular Customers acknowledged improvement in last 9 months	Col C is populated from another Sheet. SHEET2. When I double click Cell C2, it should allow me to edit the comment & save the changes in Cell C2 only.
Row 3	Laundry	No Change	No Comments
Row 4	Security	Downwards	2 cases booked on 08Apr, 2018
Row 5	etc..

<tbody>
</tbody>

Please Guide me find an answer,
Thanks in Advance.
Steeve.

 

[My Aswer Is This]

Was my last suggestion something that would work?

 

[ashyn]

Both works simply brilliant. Thank you. However I prefer the 1st Solution (only thought is if the Box can be made bigger for reading & editing full comments...)
But thank you very much for the solutions. Very Very helpful. God Bless.

If you can cover that element in your macro code, please do share.


Steeve.

 

[My Aswer Is This]

I may have another solution.
Check back here later today

 

[My Aswer Is This]

Try this:

When you double click on any cell in column C a Textbox will popup with the text that was in the cell you double click on

Modify or add to the text in the Textbox that popped up

Now when done right click on any cell in column C and your new text will now be entered in same cell you double clicked on.

Install this script in a module.
It just sets there and runs automatically any time you double click a cell in column C

Option Explicit
Public r As String '~~> at the very top of the module outside any sub
Public ans As String '~~> at the very top of the module outside any sub
Public Sub Anysub()
'Modified 5/5/18 10:00 PM EDT
r = Selection.Name
ans = ActiveCell.Address
End Sub

This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified 5/5/18 10:00 PM EDT
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Cancel = True
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 435, 90.75, 177.75, 102).Select
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)
    Selection.Left = ActiveCell.Offset(, 2).Left
    Selection.Top = ActiveCell.Offset(, 2).Top
    ShapeName = Selection.Name
    Call Anysub
    
    With Selection.ShapeRange.TextFrame2
        .TextRange.Font.Size = 16
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = ActiveCell.Value
        .TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
        .TextRange.Font.Bold = True
        .AutoSize = msoAutoSizeShapeToFitText
    End With
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
On Error GoTo M
Range(ans).Value = Shapes(r).TextFrame2.TextRange.Text
ActiveSheet.Shapes(r).Delete
Exit Sub
M:
End Sub

 

[My Aswer Is This]

Sorry. I made one small mistake:
Try this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified 5/5/18 11:15 PM EDT
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Cancel = True
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 435, 90.75, 177.75, 102).Select
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)
    Selection.Left = ActiveCell.Offset(, 2).Left
    Selection.Top = ActiveCell.Offset(, 2).Top
    ShapeName = Selection.Name
    Call Anysub
    
    With Selection.ShapeRange.TextFrame2
        .TextRange.Font.Size = 16
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = ActiveCell.Value
        .TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
        .TextRange.Font.Bold = True
        .AutoSize = msoAutoSizeShapeToFitText
    End With
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Cancel = True
On Error GoTo M
Range(ans).Value = Shapes(r).TextFrame2.TextRange.Text
ActiveSheet.Shapes(r).Delete
End If
Exit Sub
M:
End Sub

The module script I sent is OK

 

[ashyn]

It works like a miracle... You have some amazing skills & know your stuff like an expert..

Just the way I was thinking how it should look.Simply amazing.. Thank you very much "My Answer Is This".
It's made my work so smooth & High in Quality. Thank you, Thank you, Thank you...

Steeve

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.