|
Problem of With Target/End With block
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 '''''''''''''''''''''''''''''''''''''''''''' -------------------- -- chris46521 ------------------------------------------------------------------------ chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909 View this thread: http://www.excelforum.com/showthread...hreadid=566706 |
Problem of With Target/End With block
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" wrote in message ... 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 '''''''''''''''''''''''''''''''''''''''''''' -------------------- -- chris46521 ------------------------------------------------------------------------ chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909 View this thread: http://www.excelforum.com/showthread...hreadid=566706 |
Problem of With Target/End With block
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" wrote in message ... 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 '''''''''''''''''''''''''''''''''''''''''''' -------------------- -- chris46521 ------------------------------------------------------------------------ chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909 View this thread: http://www.excelforum.com/showthread...hreadid=566706 |
Problem of With Target/End With block
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 -- Regards, Tom Ogilvy "chris46521" wrote: 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 dont 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 '''''''''''''''''''''''''''''''''''''''''''' -------------------- -- chris46521 ------------------------------------------------------------------------ chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909 View this thread: http://www.excelforum.com/showthread...hreadid=566706 |
Problem of With Target/End With block
Thanks guys! That really helped -- chris4652 ----------------------------------------------------------------------- chris46521's Profile: http://www.excelforum.com/member.php...fo&userid=3590 View this thread: http://www.excelforum.com/showthread.php?threadid=56670 |
| All times are GMT +1. The time now is 12:39 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com