Problem of With Target/End With block

C

chris46521

The following code is supposed to, among many other things, add a
comment box automatically to any cell in column O where the word
“JOINT” is typed or selected. Everything else about the code works
fine, but a comment box is not automatically brought up in the cells of
column O. I know it is a problem with the With Target/End With block,
but I don’t know how to go about fixing it. Does anyone know of how I
might solve the problem with this code of With Target / End With? Thank
you.


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
''''''''''''''''''''''''''''''''''''''''''''
 
B

Bob Phillips

Change the comment code to this

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


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

chris46521 said:
The following code is supposed to, among many other things, add a
comment box automatically to any cell in column O where the word
“JOINT” is typed or selected. Everything else about the code works
fine, but a comment box is not automatically brought up in the cells of
column O. I know it is a problem with the With Target/End With block,
but I don’t know how to go about fixing it. Does anyone know of how I
might solve the problem with this code of With Target / End With? Thank
you.


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
Click to expand...
Me.Cells(.Row, "N").Value = "H" Then
 
B

Bob Phillips

Sorry, I meant

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


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

chris46521 said:
The following code is supposed to, among many other things, add a
comment box automatically to any cell in column O where the word
“JOINT” is typed or selected. Everything else about the code works
fine, but a comment box is not automatically brought up in the cells of
column O. I know it is a problem with the With Target/End With block,
but I don’t know how to go about fixing it. Does anyone know of how I
might solve the problem with this code of With Target / End With? Thank
you.


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
Click to expand...
Me.Cells(.Row, "N").Value = "H" Then
 
T

Tom Ogilvy

this worked for me:

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If UCase(Me.Cells(.Row, "O").Value) = "JOINT" Then
Set Cmnt = .Comment
If Cmnt Is Nothing Then
With Me.Cells(.Row, "O").AddComment
.Text Text:="COG MEs:" & Chr(10)
.Visible = True

End With
Else
Cmnt.Visible = False
End If
End If
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Takes too long ‘calculating cells’ 0
Code stopped working 2
Code to replace 'sumproduct' 18
Validation code not working with pasted data 0
COMBINE TWO MACROS INTO ONE 10
HOW TO CHANGE RANGE 0
HOW TO MIX TWO MACRO CODES 2
CORRECTION NEEDED 2

Top