Code to add comment box
 

I was wondering if anyone could tell me why the following code does not
automatically add a comment box to the active cell in column O when
"JOINT" is entered in. It was working before, but now the comment is
added to another cell.


Code:
--------------------
Dim Cmnt
If Me.Cells(.Row, "O").Value = "JOINT" Then
Set Cmnt = .Comment
If Cmnt Is Nothing Then
.AddComment
.Comment.Visible = True
.Comment.Text Text:="COG MEs:" & Chr(10)
.Comment.Shape.Select True
Else
.Comment.Visible = False
End If
End If
--------------------

Thanks!


--
chris46521
------------------------------------------------------------------------
chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909
View this thread: http://www.excelforum.com/showthread...hreadid=565784

Code to add comment box
 

Chris,
Assuming this code is within a "With ActiveCell / End With" block, then it
will add a comment to the active cell, not to the cell in column "O".
Show the With block as well, as that will determine the location of the
comment.

NickHK

"chris46521" wrote
in message ...

I was wondering if anyone could tell me why the following code does not
automatically add a comment box to the active cell in column O when
"JOINT" is entered in. It was working before, but now the comment is
added to another cell.


Code:
--------------------
Dim Cmnt
If Me.Cells(.Row, "O").Value = "JOINT" Then
Set Cmnt = .Comment
If Cmnt Is Nothing Then
.AddComment
.Comment.Visible = True
.Comment.Text Text:="COG MEs:" & Chr(10)
.Comment.Shape.Select True
Else
.Comment.Visible = False
End If
End If
--------------------

Thanks!


--
chris46521
------------------------------------------------------------------------
chris46521's Profile:
http://www.excelforum.com/member.php...o&userid=35909
View this thread: http://www.excelforum.com/showthread...hreadid=565784

Code to add comment box
 

Thanks for your reply! Here is the full code:


Code:
--------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "N:N"

Dim Cmnt
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Row 1 Then
If Me.Cells(.Row, "N").Value = "" Or Me.Cells(.Row, "N").Value = "O" Or Me.Cells(.Row, "N").Value = "H" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 0
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "DR" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 39
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "HJB" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 6
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "DLH" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 7
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "FDC" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 4
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "CJ" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 45
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "RT" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 20
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "GRR" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 22
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "TRG" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 54
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "GP" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 50
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "DC" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 40
End If

If Me.Cells(.Row, "O").Value = "JOINT" Then
Set Cmnt = .Comment
If Cmnt Is Nothing Then
Me.Cells(.Row, "O").AddComment
.Comment.Visible = True
.Comment.Text Text:="COG MEs:" & Chr(10)
.Comment.Shape.Select True
Else
.Comment.Visible = False
End If
End If

If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "JOINT" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 15
End If

If Me.Cells(.Row, "N") = "C" Then
Me.Cells(.Row, "Q").ClearContents
End If

If Me.Cells(.Row, "N").Value = "O" Then
Me.Cells(.Row, "AS").Value = 1
Else
Me.Cells(.Row, "AS").ClearContents
End If

If Me.Cells(.Row, "N").Value = "C" Then
Me.Cells(.Row, "AT").Value = 1
Else
Me.Cells(.Row, "AT").ClearContents
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True

If Target.Cells.Count 1 Or Target.HasFormula Then Exit Sub

On Error Resume Next
If Not Intersect(Target, Range("N:N")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If
On Error GoTo 0

If Target.Cells.Count 1 Or Target.HasFormula Then Exit Sub

On Error Resume Next
If Not Intersect(Target, Range("O:O")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If
On Error GoTo 0



End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in

''''''''''''''''''''''''''''''''''''''''''''
'Forces text to UPPER case for the range A1:B20
''''''''''''''''''''''''''''''''''''''''''''

--------------------


--
chris46521
------------------------------------------------------------------------
chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909
View this thread: http://www.excelforum.com/showthread...hreadid=565784