Excel Note VBA

jhedges

Board Regular
Joined
May 27, 2009
Messages
208
Team,

I have the following code in place to allow our team members to double click in a cell, get a msgbox for them to type into, which adds a note into the cell (red triangle top right corner). This all works fine...Except - If the person hits cancel in the msgbox it actually deletes the actual text in the Excel cell that they double clicked into. I have tried to comment out the last line of code 'Cancel = True, I have tried Cancel = False as well as Cancel = True none of which works to stop the text from being deleted out of the cell. Does anyone have some advice/recommendations to solve this issue?

VBA Code:
'Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
    On Error Resume Next
    Dim cmtText As String
    Dim staffText As String
    Dim goalText As String
    Dim Pos As Long
    Dim i As Integer
    Dim text As String
    Dim lArea As Long
    Dim TotalCommentLength As String
    Dim cmtTextLength As Long
    Dim NameLength As Long
    Dim GoalLength As Long
    Dim StaffLength As Long
    Dim StartPos As Long
    
    cmtText = InputBox("Please Enter 90 Day Action Plan(s):", "Action the Day")
    staffText = ActiveCell.Offset(0, -3).Value
    'goalText = ActiveCell.Offset(0, 0).Value
    If cmtText = "" Then Exit Sub
    NameLength = Len(Application.UserName)
    GoalLength = Len(goalText)
    StaffLength = Len(staffText)
    'include line feed at end of text to prevent format bleeding
    cmtText = Format(Now, "mm/dd/yy hh:mm:ss ampm") & "-" & Application.UserName & "-" & staffText & " " & goalText & " " & vbCrLf & "STAFF 90day Plan:" & " " & cmtText & Chr(10)
    cmtTextLength = Len(cmtText)
    If Target.Comment Is Nothing Then
        Target.AddComment text:=cmtText
    Else
        Target.NoteText Chr(10) & cmtText, 99999
    End If
    'Auto size the comment area
    With Target.Comment.Shape
        .TextFrame.AutoSize = True
        If .Width > 350 Then
            lArea = .Width * .Height
            .TextFrame.AutoSize = False
            .Width = 350
            ' An adjustment factor of 0.8 seems to work ok.
            .Height = (lArea / 350) * 0.9
        End If
    End With
    'color the date and name text
    
    TotalCommentLength = Len(Target.Comment.text)
    StartPos = TotalCommentLength - cmtTextLength + 1
    Target.Comment.Shape.TextFrame.Characters(StartPos, 20).Font.ColorIndex = 10
    Target.Comment.Shape.TextFrame.Characters(StartPos + 21, NameLength).Font.ColorIndex = 3
    Target.Comment.Shape.TextFrame.Characters(StartPos + 21 + StaffLength + 1 + NameLength + 1).Font.ColorIndex = 46
    Target.Comment.Shape.TextFrame.Characters(StartPos + 21 + StaffLength + 1 + NameLength + 1, GoalLength + 1).Font.ColorIndex = 32
    Target.Comment.Shape.TextFrame.Characters(StartPos + 21 + StaffLength + 1 + NameLength + 1 + GoalLength + 1, cmtTextLength + 1).Font.ColorIndex = 46

    'Cancel = True    'Remove this if you want to enter text in the cell after you add the comment
    
End Sub
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,938
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
    If cmtText = "" Then
      Cancel = True
      Exit Sub
    End If
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,938
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

Forum statistics

Threads
1,148,160
Messages
5,745,123
Members
423,927
Latest member
Pra56

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top